mcs/class/Mono.WebBrowser/tools/xpidl2cs/xpidl2cs.pl

   1 #!/usr/bin/perl
   2 #
   3 # xpidl2cs.pl : Generates C# interfaces from idl
   4 #
   5 # Author: Andreia Gaita <shana.ufie@gmail.com>
   6 #
   7 # Copyright (c) 2007 Novell, Inc.
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of version 2 of the GNU General Public
  11 # License as published by the Free Software Foundation.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public
  19 # License along with this program; if not, write to the
  20 # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 # Boston, MA 02111-1307, USA.
  22 ##############################################################
  23
  24
  25
  26
  27 my $file;
  28 my $path;
  29 my $nosig;
  30 my $_class;
  31 my %opt=();
  32
  33 #open FILE, '<', $path.$file or die "Can't open file $path$file";
  34
  35 my %interface = (
  36                  properties => (),
  37                  items => "",
  38                  uuid => "",
  39                  class => "",
  40                  parent => ""
  41                  );
  42 my %properties;
  43 my %methods = {
  44         type => "",
  45         params => ()
  46 };
  47
  48 my %types;
  49 $types{"short"} = {name => "short", out => "out", marshal => ""};
  50 $types{"PRUint8"} = {name => "char", out => "out", marshal => ""};
  51 $types{"PRInt8"} = {name => "char", out => "out", marshal => ""};
  52 $types{"unsigned,short"} = {name => "ushort", out => "out", marshal => ""};
  53 $types{"PRUint16"} = {name => "ushort", out => "out", marshal => ""};
  54 $types{"PRInt16"} = {name => "short", out => "out", marshal => ""};
  55 $types{"int"} = {name => "int", out => "out", marshal => ""};
  56 $types{"nsresult"} = {name => "int", out => "out", marshal => ""};
  57 $types{"unsigned,int"} = {name => "uint", out => "out", marshal => ""};
  58 $types{"PRUint32"} = {name => "UInt32", out => "out", marshal => ""};
  59 $types{"PRInt32"} = {name => "Int32", out => "out", marshal => ""};
  60 $types{"PRInt64"} = {name => "long", out => "out", marshal => ""};
  61 $types{"long"} = {name => "int", out => "out", marshal => ""};
  62 $types{"size_t"} = {name => "int", out => "out", marshal => ""};
  63 $types{"unsigned,long"} = {name => "uint", out => "out", marshal => ""};
  64 $types{"float"} = {name => "float", out => "out", marshal => ""};
  65 $types{"boolean"} = {name => "bool", out => "out", marshal => ""};
  66 $types{"PRBool"} = {name => "bool", out => "out", marshal => ""};
  67 $types{"void"} = {name => "", out => "", marshal => ""};
  68 $types{"octet"} = {name => "byte", out => "out", marshal => ""};
  69 $types{"octet[]"} = {name => "IntPtr", out => "out", marshal => " "};
  70 $types{"byte"} = {name => "byte", out => "out", marshal => ""};
  71 $types{"DOMString"} = {name => "/*DOMString*/ HandleRef", out => "", marshal => ""};
  72 $types{"AUTF8String"} = {name => "/*AUTF8String*/ HandleRef", out => "", marshal => ""};
  73 $types{"ACString"} = {name => "/*ACString*/ HandleRef", out => "", marshal => ""};
  74 $types{"AString"} = {name => "/*AString*/ HandleRef", out => "", marshal => ""};
  75 $types{"wstring"} = {name => "string", out => "", marshal => "MarshalAs(UnmanagedType.LPWStr)"};
  76 $types{"nsCIDRef"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
  77 $types{"nsIIDRef"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
  78 $types{"Guid"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
  79 $types{"nsCID"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
  80 $types{"nsCIDPtr"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
  81 $types{"string"} = {name => "string", out => "ref", marshal => "MarshalAs (UnmanagedType.LPStr)"};
  82 $types{"refstring"} = {name => "IntPtr", out => "ref", marshal => ""};
  83 $types{"charPtr"} = {name => "StringBuilder", out => "", marshal => ""};
  84 $types{"voidPtr"} = {name => "IntPtr", out => "", marshal => ""};
  85 $types{"nsISupports"} = {name => "IntPtr", out => "out", marshal =>"MarshalAs (UnmanagedType.Interface)"};
  86 $types{"DOMTimeStamp"} = {name => "int", out => "out", marshal => ""};
  87 $types{"nsWriteSegmentFun"} = {name => "nsIWriteSegmentFunDelegate", out => "", marshal => ""};
  88 $types{"nsReadSegmentFun"} = {name => "nsIReadSegmentFunDelegate", out => "", marshal => ""};
  89 $types{"nsTimerCallbackFunc"} = {name => "nsITimerCallbackDelegate", out => "", marshal => ""};
  90 $types{"nsLoadFlags"} = {name => "ulong", out => "out", marshal => ""};
  91 $types{"nsQIResult"} = {name => "IntPtr", out => "out", marshal => ""};
  92 $types{"nsIIDPtr[]"} = {name => "IntPtr", out => "out", marshal => ""};
  93 $types{"PRFileDescStar"} = {name => "IntPtr", out => "out", marshal => ""};
  94 $types{"PRLibraryStar"} = {name => "IntPtr", out => "out", marshal => ""};
  95 $types{"FILE"} = {name => "IntPtr", out => "out", marshal => ""};
  96 $types{"nsIPresShell"} = {name => "/*nsIPresShell*/ IntPtr", out => "out", marshal => ""};
  97 $types{"nsIDocument"} = {name => "/*nsIDocument*/ IntPtr", out => "out", marshal => ""};
  98 $types{"nsIFrame"} = {name => "/*nsIFrame*/ IntPtr", out => "out", marshal => ""};
  99 $types{"nsObjectFrame"} = {name => "/*nsObjectFrame*/ IntPtr", out => "out", marshal => ""};
 100 $types{"nsIContent"} = {name => "/*nsIContent*/ IntPtr", out => "out", marshal => ""};
 101 $types{"others"} = {name => "", out => "out", marshal => "MarshalAs (UnmanagedType.Interface)"};
 102
 103 my %returnvalues;
 104 $returnvalues{"short"} = {value => "0"};
 105 $returnvalues{"ushort"} = {value => "0"};
 106 $returnvalues{"int"} = {value => "0"};
 107 $returnvalues{"uint"} = {value => "0"};
 108 $returnvalues{"UInt32"} = {value => "0"};
 109 $returnvalues{"Int32"} = {value => "0"};
 110 $returnvalues{"long"} = {value => "0"};
 111 $returnvalues{"ulong"} = {value => "0"};
 112 $returnvalues{"IntPtr"} = {value => "0"};
 113 $returnvalues{"float"} = {value => "0"};
 114 $returnvalues{"byte"} = {value => "0"};
 115 $returnvalues{"IntPtr"} = {value => "IntPtr.Zero"};
 116 $returnvalues{"string"} = {value => "String.Empty"};
 117 $returnvalues{"bool"} = {value => "false"};
 118 $returnvalues{"/*DOMString*/ HandleRef"} = {value => "null"};
 119 $returnvalues{"/*AUTF8String*/ HandleRef"} = {value => "null"};
 120 $returnvalues{"ACString*/ HandleRef"} = {value => "null"};
 121 $returnvalues{"/*AString*/ HandleRef"} = {value => "null"};
 122 $returnvalues{""} = {value => ""};
 123 $returnvalues{"others"} = {value => "null"};
 124
 125 my %names;
 126 $names{"event"} = {name => "_event"};
 127 $names{"lock"} = {name => "_lock"};
 128
 129 my %dependents;
 130
 131 my $class_implementation;
 132
 133
 134
 135 sub usage ()
 136 {
 137         print STDERR << "EOF";
 138     Usage: xpidl2cs.pl -f file -p path/to/idl [-nh -c class]
 139     -h          : this help
 140     -f          : idl file to parse, with extension
 141     -p          : path to the idl file directory
 142     -n          : generate files with no PreserveSig attribute (optional, defaults to adding the attribute)
 143     -c          : specific class to use inside the idl file (optional)
 144 EOF
 145         exit;
 146 }
 147
 148 sub init ()
 149 {
 150         use Getopt::Std;
 151         my $opts = 'f:p:c:n';
 152         getopts( "$opts", \%opt ) or usage();
 153         usage if $opt{h};
 154
 155         usage() if !$opt{f} or !$opt{p};
 156
 157         $file = $opt{f};
 158         $path = $opt{p};
 159         open FILE, '<', $path.$file or die "Can't open file $path$file";
 160
 161         $nosig = 1 if $opt{n};
 162         $_class = $opt{c};
 163 }
 164
 165
 166 sub trim{
 167 #print "trim\n";
 168     $_[0]=~s/^\s+//;
 169     $_[0]=~s/\s+$//;
 170     return;
 171 }
 172
 173 sub parse_parent {
 174 #print "parse_parent\n";
 175     my $x = shift;
 176
 177         print "Parsing parent $x\n";
 178     `perl xpidl2cs.pl $x.idl $path $nosig`;
 179
 180     open my $f, '<', "$x.cs";
 181     my $start = 0;
 182     my $out;
 183     while (my $line = <$f>) {
 184                 chop $line;
 185                 if (!$start) {
 186                         if ($line =~ /#region/) {
 187                                 $start = 1;
 188                                 $out .= $line . "\n";
 189                         }
 190                 }
 191                 elsif ($line =~ /\}/) {
 192             last;
 193                 }
 194                 else {
 195                         $out .= $line . "\n";
 196                 }
 197     }
 198
 199     return $out;
 200 }
 201
 202 sub has_setter {
 203 #print "has_setter\n";
 204     my $x = shift;
 205     return !$properties{$x}->{"setter"};
 206 }
 207
 208 sub get_name {
 209 #print "get_name\n";
 210     my $x = shift;
 211
 212     if (exists $names{$x}) {
 213                 return $names{$x}->{"name"};
 214     }
 215     return $x;
 216 }
 217
 218 sub get_type {
 219 #print "get_type\n";
 220     my $x = shift;
 221     my $out = shift;
 222     my $arr = shift;
 223
 224 #    print "arr = $arr ; out = $out ; name = $x\n";
 225
 226     if ($out) {
 227                 if ($arr && exists $types{"$out$x\[\]"}) {
 228                         return $types{"$out$x\[\]"}->{"name"};
 229                 } elsif ($arr && exists $types{"$out$x"}) {
 230                         return $types{"$out$x"}->{"name"}."[]";
 231                 } elsif (exists $types{"$out$x"}) {
 232                         return $types{"$out$x"}->{"name"};
 233                 }
 234     }
 235
 236     if (exists $types{$x} || ($arr && exists $types{"$x\[\]"})) {
 237                 if ($arr && exists $types{"$x\[\]"}) {
 238                         return $types{"$x\[\]"}->{"name"};
 239                 } elsif ($arr) {
 240                         return $types{$x}->{"name"}."[]";
 241                 } else {
 242                         return $types{$x}->{"name"};
 243                 }
 244     }
 245     return $x;
 246 }
 247
 248 sub get_out {
 249 #print "get_out\n";
 250     my $x = shift;
 251     if (exists $types{$x}) {
 252                 return $types{$x}->{"out"};
 253     }
 254     return $types{"others"}->{"out"};
 255 }
 256
 257 sub get_marshal {
 258 #print "get_marshal\n";
 259     my $x = shift;
 260     my $out = shift;
 261     my $arr = shift;
 262
 263     if ($out) {
 264                 if ($arr && exists $types{"$out$x\[\]"}) {
 265                         return $types{"$out$x\[\]"}->{"marshal"};
 266                 } elsif (exists $types{"$out$x"}) {
 267                         return $types{"$out$x"}->{"marshal"};
 268                 }
 269     }
 270
 271     if (exists $types{$x} || ($arr && exists $types{"$x\[\]"})) {
 272                 if ($arr && exists $types{"$x\[\]"}) {
 273                         return $types{"$x\[\]"}->{"marshal"};
 274                 } else {
 275                         return $types{$x}->{"marshal"};
 276                 }
 277     }
 278
 279     return $types{"others"}->{"marshal"};
 280 }
 281
 282 sub get_return_value {
 283 #print "get_return_value\n";
 284     my $x = shift;
 285     if (exists $returnvalues{$x}) {
 286                 return $returnvalues{$x}->{"value"};
 287     }
 288     return $returnvalues{"others"}->{"value"};
 289 }
 290
 291
 292 sub is_property {
 293 #print "is_property\n";
 294     my $x = shift;
 295     return (exists $properties{$x});
 296 }
 297
 298 sub add_external {
 299 #print "add_external\n";
 300     my $x = shift;
 301     if ($x !~ /nsISupports/ && !exists $types{$x} && !exists $dependents{$x}) {
 302                 $dependents{$x} = $x;
 303     }
 304 #    print "add_external $x\n";
 305 }
 306
 307 sub get_params {
 308 #print "get_params\n";
 309     my $x = shift;
 310     my %list;
 311 #print $methods{$x}->{"params"}."\n";
 312     my @params = split /,/, $methods{$x}->{"params"};
 313         my $lastoutparam = "";
 314         my @ret = ();
 315
 316 #print "params:@params:\n";
 317     for my $param (@params) {
 318                 my $marshal;
 319                 my $name;
 320                 my $type;
 321                 my $out;
 322                 my $isout;
 323
 324
 325 #       print "param:$param:\n";
 326                 my @p = split (" ", $param);
 327 #       print "@p\n";
 328 # need to backtrack to a previous parameter defined by iid_is(name) and
 329 # replace the type of this one with that. who the $%#@ came up with this idea? le sigh.
 330
 331                 if (@p[0] =~ m/iid_is/) {
 332                     shift @p;
 333                     $name = &get_name (@p[0]);
 334                     $name =~ s/ //;
 335                     $type = $list{$name}->{"type"};
 336                 $marshal = $list{$name}->{"marshal"};
 337                     $marshal = " " if !$marshal;
 338                     $name = "";
 339                     until (scalar(@p) == 3) {
 340                                 shift @p;
 341                     }
 342                 }
 343
 344                 if (@p[0] =~ m/array/ || @p[1] =~ m/array/) {
 345                     until (scalar(@p) == 3) {
 346                                 shift @p;
 347                     }
 348                 $isout = 1 if (@p[0] =~ m/out/);
 349                     shift @p;
 350                     $marshal = &get_marshal (@p[0], "", 1);
 351                 $type = &get_type(@p[0], "", 1);
 352                 }
 353
 354                 shift @p unless @p[0] =~ /(in|out)/;
 355                 $isout = 1 if (@p[0] =~ m/out/);
 356                 shift @p unless scalar(@p) <= 2;
 357
 358         # if an out parameter is of type nsQIResult, that means
 359         # it will return a pointer to an interface (that can be anything).
 360         # That means we want to return an IntPtr, and later cast it to
 361         # the proper type, so reset type and marshalling
 362                 if ($isout && @p[0] =~ /nsQIResult/) {
 363                     $marshal = "";
 364                 $type = "";
 365                 }
 366
 367                 if (!$type) {
 368                 $type = join ",", @p[0..@p-2];
 369                     $type=~s/\[.*\],//;
 370                     until (scalar(@p) == 1) {
 371                                 shift @p;
 372                         }
 373
 374                     $marshal = &get_marshal ($type);
 375                 $marshal = " " if !$marshal;
 376                     $type = &get_type ($type);
 377                     $name = &get_name (@p[0]);
 378                 }
 379 #print "marshal:$marshal\ttype:$type\tname:$name\n";
 380                 $out = &get_out($type) if $isout;
 381
 382                 $type = &get_type (@p[0]) unless $type;
 383                 shift @p unless scalar(@p) == 1;
 384                 $marshal = &get_marshal ($type) unless $marshal;
 385                 $name = &get_name (@p[0]) unless $name;
 386
 387 #print "marshal:$marshal\ttype:$type\tname:$name\n";
 388
 389                 $list{$name} = {
 390                     name => $name,
 391                     type => $type,
 392                     marshal => $marshal,
 393                 out => $out,
 394                         isout => $isout
 395                 };
 396
 397                 &add_external ($type);
 398
 399                 $marshal = "" if $marshal eq " ";
 400
 401 #               my $tmp = "\n\t\t\t\t";
 402                 my $tmp = "";
 403                 $tmp .= "[$marshal] " if $marshal;
 404                 $tmp .= "$out $type $name";
 405                 push (@ret, $tmp);
 406                 $lastoutparam = $name if $isout;
 407 #print "tmp:$tmp\n";
 408     }
 409
 410 #print "$methods{$x}->{\"type\"}\n";
 411 #print "nosig:$nosig;x:$x;type:" . &get_type ($methods{$x}->{"type"}) . ";\n";
 412         if (!$nosig && $x !~ /void/ && &get_type ($methods{$x}->{"type"}) ne "") {
 413                 $type = $methods{$x}->{"type"};
 414                 $type =~ s/\[.*\],//;
 415                 $marshal = &get_marshal ($type);
 416
 417                 my $tmp = "";
 418                 $tmp = "[$marshal] " if $marshal;
 419                 $tmp .= &get_out($type);
 420                 $tmp .= " " . &get_type ($type);
 421                 $tmp .= " ret";
 422 #print "tmp 2:$tmp\n";
 423                 push (@ret, $tmp);
 424
 425                 &add_external ($type);
 426     }
 427
 428         if ($nosig && &get_type ($methods{$x}->{"type"}) eq "" && $lastoutparam) {
 429                 $methods{$x}->{"type"} = $list{$lastoutparam}->{"type"};
 430                 pop (@ret);
 431         }
 432 #print "@ret\n";
 433
 434         return join (",\n\t\t\t\t", @ret);
 435 }
 436
 437 sub parse_file {
 438 #print "parse_file\n";
 439     my $method = 0;
 440     my $mname = '';
 441     my $mtype = '';
 442     my $mparams = '';
 443     my $start = 0;
 444         my $comment = 0;
 445
 446     while (my $line = <FILE>) {
 447                 chop $line;
 448
 449                 next if !$start && $line !~ /uuid\(/;
 450                 $start = 1;
 451                 last if $start && $line =~ /\};/;
 452
 453                 trim ($line);
 454
 455                 if (index($line, "/*") > -1) {
 456                         $comment = 1;
 457                         next;
 458                 }
 459                 if ($comment && index($line, "*/") > -1) {
 460                         $comment = 0;
 461                         next;
 462                 }
 463
 464                 next if $comment;
 465
 466                 if (index($line, "*") == -1 && index ($line, "//") == -1 && index ($line, "#include") == -1) {
 467
 468                         $line =~ s/\[noscript\] //;
 469
 470                         if (index ($line, "uuid(") != -1) {
 471                                 my $uuid = $line;
 472                                 $uuid =~ s/\[.*uuid\((.*)\)\]/\1/;
 473                                 $interface->{"uuid"} = $uuid;
 474                         }
 475
 476                         elsif (index($line, "interface") != -1) {
 477                                 my $class = $line;
 478                                 $class =~ s/interface ([^\:|\s]+)\s*:\s*(.*)/\1/;
 479 #               print "\t\tclass:$class\n";
 480 #               print "\t\t_class:$_class\n";
 481                                 if ($_class && $_class !~ $class) {
 482                                         $uuid = '';
 483                                         $class = '';
 484                                         $method = 0;
 485                                         $mname = '';
 486                                         $mtype = '';
 487                                         $mparams = '';
 488                                         $start = 0;
 489                                         $comment = 0;
 490                                         next;
 491                                 }
 492
 493                                 my $parent = $line;
 494                                 $parent =~ s/([^\:]+):\s*(.*)[\s|\{]/\2/;
 495 #               print "\t\tparent:$parent\n";
 496                                 $interface->{"class"} = $class;
 497                                 $interface->{"parent"} = $parent;
 498                         }
 499                         elsif (index ($line, "const") != -1 && index ($line, "[") == -1) {
 500                                 next;
 501                         }
 502                         elsif (index ($line, "attribute") != -1) {
 503                                 my $att = substr($line, index($line, "attribute") + 10);
 504
 505                                 my @atts = split / /, $att;
 506
 507                                 my $name = pop @atts;
 508                                 $name =~ s/;//;
 509 #           print $name . "\n";
 510                                 my @nospaces = grep /[^ ]/, @atts;
 511                                 my $type = join ",", @nospaces;
 512
 513                                 my $setter = 0;
 514                                 if (index ($line, "readonly") != -1) {
 515                                         $setter = 1;
 516                                 }
 517 #            print $type . "\n";
 518                                 $properties{$name} = {type => $type, setter => $setter};
 519                                 $interface->{"items"} .= $name . ",";
 520                         }
 521                         elsif ($line !~ m/[{|}]/ && $line =~ m/./) {
 522 #               print $line . "\n";
 523                                 if (!$method) {
 524                                         $method = 1;
 525                                         my  $m = substr($line, 0, index($line, "("));
 526                                         my @atts = split / /, $m;
 527
 528 #                   print "$m\n";
 529                                         $mname = pop @atts;
 530 #                   print "name=$mname\n";
 531                                         my @nospaces = grep /[^ ]/, @atts;
 532                                         $mtype = join ",", @nospaces;
 533                                         $mtype =~ s/\[.*\],//;
 534 #                   print "type=$mtype\n";
 535                                         $mparams .= substr($line, index($line, "(") + 1);
 536                                         $mparams =~ s/;//;
 537                                         $mparams =~ s/\)//;
 538
 539                                         @atts = split / /, $mparams;
 540                                         @nospaces = grep /[^ ]/, @atts;
 541                                         $mparams = join " ", @nospaces;
 542 #                   print "params=>$mparams\n";
 543
 544                                 }
 545                                 elsif (index ($line, "raises") == -1) {
 546                                         $mparams .= $line;
 547                                         $mparams =~ s/;//;
 548                                         $mparams =~ s/\)//;
 549                                         my @atts = split / /, $mparams;
 550                                         my @nospaces = grep /[^ ]/, @atts;
 551                                         $mparams = join " ", @nospaces;
 552 #                   print "params=>$mparams\n";
 553                                 }
 554                                 if (index ($line, ";") != -1) {
 555                                         $method = 0;
 556                                         $mparams =~ s/\[([^\]]+),([^\]]+),([^\]]+)\]/\1 \2 \3/;
 557                                         $mparams =~ s/\[([^\]]+),([^\]]+)\]/\1 \2/;
 558                                         $mparams =~ s/\(/ /;
 559                                         $mparams =~ s/\)//;
 560                                         $mparams =~ s/retval//;
 561
 562                                         $methods{$mname} = {type => $mtype, params => $mparams};
 563                                         $interface->{"items"} .= $mname . ",";
 564 #                   print "params=>$mparams\n";
 565                                         $mname = '';
 566                                         $mtype = '';
 567                                         $mparams = '';
 568                                 }
 569                         }
 570                 }
 571     }
 572 }
 573
 574
 575 sub output {
 576 #print "output\n";
 577     my $name = $interface->{"class"};
 578     print "$name.cs\n";
 579     open X, ">$name.cs";
 580     print X "// THIS FILE AUTOMATICALLY GENERATED BY xpidl2cs.pl\n";
 581     print X "// EDITING IS PROBABLY UNWISE\n";
 582     print X "// Permission is hereby granted, free of charge, to any person obtaining\n";
 583     print X "// a copy of this software and associated documentation files (the\n";
 584     print X "// \"Software\"), to deal in the Software without restriction, including\n";
 585     print X "// without limitation the rights to use, copy, modify, merge, publish,\n";
 586     print X "// distribute, sublicense, and/or sell copies of the Software, and to\n";
 587     print X "// permit persons to whom the Software is furnished to do so, subject to\n";
 588     print X "// the following conditions:\n";
 589     print X "// \n";
 590     print X "// The above copyright notice and this permission notice shall be\n";
 591     print X "// included in all copies or substantial portions of the Software.\n";
 592     print X "// \n";
 593     print X "// THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,\n";
 594     print X "// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF\n";
 595     print X "// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND\n";
 596     print X "// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE\n";
 597     print X "// LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION\n";
 598     print X "// OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION\n";
 599     print X "// WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\n";
 600     print X "//\n";
 601     print X "// Copyright (c) 2007, 2008 Novell, Inc.\n";
 602     print X "//\n";
 603     print X "// Authors:\n";
 604     print X "// Andreia Gaita (avidigal\@novell.com)\n";
 605     print X "//\n";
 606     print X "\n";
 607     print X "using System;\n";
 608     print X "using System.Runtime.InteropServices;\n";
 609     print X "using System.Runtime.CompilerServices;\n";
 610     print X "using System.Text;\n";
 611     print X "\n";
 612     print X "namespace Mono.Mozilla {\n";
 613     print X "\n";
 614
 615     my $uuid = $interface->{"uuid"};
 616     my $parent = $interface->{"parent"};
 617     print X "\t[Guid (\"$uuid\")]\n";
 618     print X "\t[InterfaceType (ComInterfaceType.InterfaceIsIUnknown)]\n";
 619     print X "\t[ComImport ()]\n";
 620     print X "\tinternal interface $name";
 621     print X " : $parent" if $parent !~ /nsISupports/;
 622     print X " {\n";
 623
 624     if ($parent !~ /nsISupports/) {
 625                 print X &parse_parent ($parent);
 626     }
 627     print X "\n";
 628     print X "#region $name\n";
 629
 630     my @items = split ",", $interface->{"items"};
 631     for my $item (@items) {
 632
 633                 if (!$nosig) {
 634                         print X "\t\t[PreserveSigAttribute]\n";
 635                 }
 636                 print X "\t\t[MethodImpl (MethodImplOptions.InternalCall, MethodCodeType = MethodCodeType.Runtime)]\n";
 637
 638                 if (&is_property ($item)) {
 639                         my $out = &get_out($properties{$item}->{"type"});
 640                         my $marshal = &get_marshal($properties{$item}->{"type"}, $out);
 641                         my $type = &get_type ($properties{$item}->{"type"}, $out);
 642                         my $name = ucfirst ($item);
 643
 644                         &add_external ($properties{$item}->{"type"});
 645 ## getter
 646                         print X "\t\t";
 647                         if ($nosig) {
 648                                 print X "[return: $marshal] " if $marshal;
 649                                 print X "$type get$name ();\n";
 650                         } else {
 651                                 print X "int get$name (";
 652                                 print X "[$marshal] " if $marshal;
 653                                 print X "$out $type ret);\n";
 654                         }
 655                         print X "\n";
 656
 657                         $type = &get_type ($properties{$item}->{"type"});
 658                         $marshal = &get_marshal($properties{$item}->{"type"});
 659
 660 ## setter
 661                         if (&has_setter($item)) {
 662                                 if (!$nosig) {
 663                                         print X "\t\t[PreserveSigAttribute]\n";
 664                                 }
 665                                 print X "\t\t[MethodImpl (MethodImplOptions.InternalCall, MethodCodeType = MethodCodeType.Runtime)]\n";
 666                                 if ($nosig) {
 667                                         print X "\t\tvoid";
 668                                 } else {
 669                                         print X "\t\tint";
 670                                 }
 671                                 print X " set$name (";
 672                                 print X "[$marshal] " if $marshal;
 673                                 print X "$type value);\n";
 674                                 print X "\n";
 675                         }
 676
 677                 } else {
 678                         my $type = &get_type ($methods{$item}->{"type"});
 679                         my $out = &get_out($methods{$item}->{"type"}) if $type;
 680                         my $marshal = &get_marshal($methods{$item}->{"type"}, $out) if $type;
 681                         $type = "void" if !$type;
 682
 683                         print X "\t\t";
 684                         if ($nosig) {
 685                                 print X "[return: $marshal] " if $marshal;
 686                                 print X "$type $item (";
 687                                 print X &get_params($item);
 688                                 print X ");";
 689                         } else {
 690                                 print X "int $item (";
 691                                 print X &get_params($item);
 692                                 print X ");";
 693                         }
 694                         print X "\n\n";
 695                 }
 696     }
 697     print X "#endregion\n";
 698     print X "\t}\n";
 699
 700
 701 # mozilla-specific helper classes to proxy objects between threads
 702 # remove if you're not running this for mono.mozilla
 703
 704     print X "\n\n";
 705     $helpername = $name;
 706     $helpername =~ s/nsI/ns/;
 707     print X "\tinternal class $helpername";
 708     print X " {\n";
 709     print X "\t\tpublic static $name GetProxy (Mono.WebBrowser.IWebBrowser control, $name obj)\n";
 710     print X "\t\t{\n";
 711     print X "\t\t\tobject o = Base.GetProxyForObject (control, typeof($name).GUID, obj);\n";
 712     print X "\t\t\treturn o as $name;\n";
 713     print X "\t\t}\n";
 714     print X "\t}\n";
 715
 716 #end of mozilla-specific helper classes
 717
 718     print X "}\n";
 719
 720
 721         &generate_class_implementation_example ();
 722
 723
 724     close X;
 725 }
 726
 727 sub generate_dependents {
 728 #print "generate_dependents\n";
 729     for my $dependent (keys %dependents) {
 730                 if (! (-e "$dependent.cs") && -e "$path$dependent.idl" && $file != $dependent) {
 731                         print "generating $path$dependent.idl\n";
 732                         my $cmd = "perl xpidl2cs.pl -f $dependent.idl -p $path";
 733                         $cmd .= "-n" if $nosig;
 734                         my $ret = `$cmd`;
 735                         print "\n$ret";
 736                 }
 737     }
 738 }
 739
 740 sub generate_class_implementation_example {
 741 #print "generate_class_implementation_example\n";
 742     my $name = $interface->{"class"};
 743         my $interfacename = $interface->{"class"};
 744     my $helpername = $name;
 745     $helpername =~ s/nsI//;
 746     my $parent = $interface->{"parent"};
 747
 748         print X "#if example\n\n";
 749     print X "using System;\n";
 750     print X "using System.Runtime.InteropServices;\n";
 751     print X "using System.Runtime.CompilerServices;\n";
 752     print X "using System.Text;\n";
 753     print X "\n";
 754
 755     print X "\tinternal class $helpername";
 756     print X " : $interfacename";
 757     print X " {\n";
 758
 759     print X "\n";
 760     print X "#region $interfacename\n";
 761
 762     my @items = split ",", $interface->{"items"};
 763     for my $item (@items) {
 764
 765                 if (&is_property ($item)) {
 766                         my $out = &get_out($properties{$item}->{"type"});
 767                         my $marshal = &get_marshal($properties{$item}->{"type"}, $out);
 768                         my $type = &get_type ($properties{$item}->{"type"}, $out);
 769
 770                         my $retval = &get_return_value($type);
 771                         my $name = ucfirst ($item);
 772
 773 ## getter
 774                         print X "\t\t";
 775                         if ($nosig) {
 776                                 print X "[return: $marshal] " if $marshal;
 777                                 print X "$type $interfacename.get$name ()\n";
 778                         } else {
 779                                 print X "int $interfacename.get$name (";
 780                                 print X "[$marshal] " if $marshal;
 781                                 print X "$out $type ret)\n";
 782                         }
 783
 784                         print X "\n\t\t{\n";
 785                         print X "\t\t\t";
 786
 787                         print X "return $retval;\n";
 788
 789                         print X "\t\t";
 790                         print X "}\n";
 791                         print X "\n";
 792
 793                         $type = &get_type ($properties{$item}->{"type"});
 794                         $retval = &get_return_value($type);
 795                         $marshal = &get_marshal($properties{$item}->{"type"});
 796
 797 ## setter
 798                         if (&has_setter($item)) {
 799                                 if ($nosig) {
 800                                         print X "\t\tvoid";
 801                                 } else {
 802                                         print X "\t\tint";
 803                                 }
 804                                 print X " $interfacename.set$name (";
 805                                 print X "[$marshal] " if $marshal;
 806                                 print X "$type value)\n";
 807                                 print X "\n";
 808
 809                                 print X "\n\t\t{\n";
 810                                 print X "\t\t\t";
 811
 812                                 print X "return $retval;\n";
 813
 814                                 print X "\t\t";
 815                                 print X "}\n";
 816                                 print X "\n";
 817                         }
 818
 819                 } else {
 820                         my $type = &get_type ($methods{$item}->{"type"});
 821                         my $out = &get_out($methods{$item}->{"type"}) if $type;
 822                         my $marshal = &get_marshal($methods{$item}->{"type"}, $out) if $type;
 823                         $type = "void" if !$type;
 824
 825                         print X "\t\t";
 826                         if ($nosig) {
 827                                 print X "[return: $marshal] " if $marshal;
 828                                 print X "$type $interfacename.$item (";
 829                                 print X &get_params($item);
 830                                 print X ")";
 831                         } else {
 832                                 print X "int $interfacename.$item (";
 833                                 print X &get_params($item);
 834                                 print X ")";
 835                         }
 836
 837                         print X "\n\t\t{\n";
 838                         print X "\t\t\t";
 839
 840                         print X "return $retval;\n";
 841
 842                         print X "\t\t";
 843                         print X "}\n";
 844                         print X "\n";
 845                         print X "\n\n";
 846                 }
 847     }
 848     print X "#endregion\n";
 849     print X "\t}\n";
 850
 851
 852     print X "#endif\n";
 853
 854 }
 855
 856 &init();
 857 &parse_file ();
 858 &output ();
 859 &generate_dependents ();