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