kalyptus/kalyptusCxxToSwig.pm

   1 package kalyptusCxxToSwig;
   2
   3 use File::Path;
   4 use File::Basename;
   5
   6 use Carp;
   7 use Ast;
   8 use kdocAstUtil;
   9 use kdocUtil;
  10 use Iter;
  11 use kalyptusDataDict;
  12
  13 use strict;
  14 no strict "subs";
  15
  16 use vars qw/ @clist $host $who $now $gentext %functionId $docTop %typedeflist
  17         $lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount
  18         $constructorCount *CLASS *HEADER *QTCTYPES *KDETYPES /;
  19
  20 BEGIN
  21 {
  22 @clist = ();
  23
  24 %typedeflist =
  25 (
  26    'signed char' => 'char',
  27    'unsigned char' => 'uchar',
  28    'signed short' => 'short',
  29    'unsigned short' => 'ushort',
  30    'signed' => 'int',
  31    'signed int' => 'int',
  32    'unsigned' => 'uint',
  33    'unsigned int' => 'uint',
  34    'signed long' => 'long',
  35    'unsigned long' => 'ulong',
  36    'QWSEvent*'  =>  'void*',
  37    'QDiskFont*'  =>  'void*',
  38    'XEvent*'  =>  'void*',
  39    'QStyleHintReturn*'  =>  'void*',
  40    'FILE*'  =>  'void*',
  41    'QUnknownInterface*'  =>  'void*',
  42    'GDHandle'  =>  'void*',
  43    '_NPStream*'  =>  'void*',
  44    'QTextFormat*'  =>  'void*',
  45    'QTextDocument*'  =>  'void*',
  46    'QTextCursor*'  =>  'void*',
  47    'QTextParag**'  =>  'void*',
  48    'QTextParag* *'  =>  'void*',
  49    'QTextParag*'  =>  'void*',
  50    'QRemoteInterface*'  =>  'void*',
  51    'QSqlRecordPrivate*'  =>  'void*',
  52    'QTSMFI'  =>  'void*', # QTextStream's QTSManip
  53    'const GUID&'  =>  'void*',
  54    'QWidgetMapper*'  =>  'void*',
  55    'QWidgetMapper *'  =>  'void*',
  56    'MSG*'  =>  'void*',
  57    'const QSqlFieldInfoList&'  =>  'void*', # QSqlRecordInfo - TODO (templates)
  58
  59    'QPtrCollection::Item'  =>  'void*', # to avoid a warning
  60
  61    'mode_t'  =>  'long',
  62    'QProcess::PID'  =>  'long',
  63    'size_type'  =>  'int', # QSqlRecordInfo
  64    'Qt::ComparisonFlags'  =>  'uint',
  65    'Qt::ToolBarDock'  =>  'int', # compat thing, Qt shouldn't use it
  66    'QIODevice::Offset'  =>  'ulong',
  67    'WState'  =>  'int',
  68    'WId'  =>  'ulong',
  69    'QRgb'  =>  'uint',
  70    'QRgb *'  =>  'uint*',
  71    'QRgb*'  =>  'uint*',
  72    'const QCOORD*'  =>  'const int*',
  73    'QCOORD*'  =>  'int*',
  74    'QCOORD'  =>  'int',
  75    'QCOORD &'  =>   'int&',
  76    'QTSMFI'  =>  'int',
  77    'Qt::WState'  =>  'int',
  78    'Qt::WFlags'  =>  'int',
  79    'Qt::HANDLE' => 'uint',
  80    'QEventLoop::ProcessEventsFlags' => 'uint',
  81    'QStyle::SCFlags' => 'int',
  82    'QStyle::SFlags' => 'int',
  83    'QStyleOption&' => 'int&',
  84    'const QStyleOption&' => 'const int&',
  85    'Q_INT16' => 'short',
  86    'Q_INT32' => 'int',
  87    'Q_INT8' => 'char',
  88    'Q_LONG' => 'long',
  89    'Q_UINT16' => 'ushort',
  90    'Q_UINT32' => 'uint',
  91    'Q_UINT8' => 'uchar',
  92    'Q_ULONG' => 'long',
  93 );
  94         # Page footer
  95
  96         $who = kdocUtil::userName();
  97         $host = kdocUtil::hostName();
  98         $now = localtime;
  99         $gentext = "$who\@$host on $now, using kalyptus $main::Version.";
 100
 101         $docTop =<<EOF
 102     begin                : $now
 103     copyright            : (C) 2003 Ian Geiser, Zack Rusin
 104     email                : geiseri\@kde.org, zack\@kde.org
 105     generated by         : $gentext
 106  ***************************************************************************/
 107
 108 /***************************************************************************
 109  *                                                                         *
 110  *   This library is free software; you can redistribute it and/or modify  *
 111  *   it under the terms of the GNU Library General Public License as       *
 112  *   published by the Free Software Foundation; either version 2 of the    *
 113  *   License, or (at your option) any later version.                       *
 114  *                                                                         *
 115  ***************************************************************************/
 116
 117 EOF
 118
 119 }
 120
 121 # Returns 1 if the $kid of the $node should be skipped
 122 sub skipMethod($$)
 123 {
 124   my ($node, $kid) = @_;
 125
 126   if ( $kid->{NodeType} ne "method" ) {
 127     return 1;
 128   }
 129
 130   my $access = $kid->{Access};
 131 #  if ( $access eq "private" ||  $access eq "private_slots" || $access eq "signals" ) {
 132   if (  $access eq "private_slots" || $access eq "signals" ) {
 133     return 1;
 134   }
 135   return undef;
 136 }
 137
 138 # returns 1 if the $kid is not a protected method of object $node
 139 sub isNotProtectedMethod($$)
 140 {
 141   my ($node, $kid) = @_;
 142
 143   print "HERE $node->{NodeType} $node->{astNodeName}, $kid->{NodeType} $kid->{astNodeName} \n";
 144   if ( $kid->{NodeType} ne "method" ) {
 145     return 1;
 146   }
 147
 148   my $access = $kid->{Access};
 149   if ( $access ne "protected" &&  $access ne "protected_slots" ) {
 150     return 1;
 151   }
 152   return undef;
 153
 154 }
 155
 156 # Returns the list of all classes this one inherits
 157 # If $recurse is defined function returns also all the parents
 158 # of the classes $classNode inherits from
 159 sub superClassList($;$)
 160 {
 161     my $classNode = shift;
 162     my $recurse = shift;
 163     my @super;
 164     my @nodes;
 165
 166     Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
 167                        push @super, @_[0];
 168                        if ( defined $recurse ) {
 169                          push @super, superClassList( @_[0] );
 170                        }
 171                      }, undef );
 172
 173     return @super;
 174 }
 175
 176 # Returns the names of the classes the $classNode
 177 # inherits from
 178 sub parentClassNames($)
 179 {
 180   my $classNode = shift;
 181   my @names;
 182   my @supers = superClassList($classNode);
 183   foreach my $class (@supers) {
 184     push @names, $class->{astNodeName};
 185   }
 186
 187   return @names;
 188 }
 189
 190 #doesn't do anything, for me to test
 191 sub hasPublicConstructors($)
 192 {
 193   my ($node) = @_;
 194   our $exists;
 195   Iter::MembersByType ( $node,
 196                         sub { print SWIG_HEADER "1) @_\n"; },
 197                         sub {   my ($node, $kid ) = @_;
 198                                 print SWIG_HEADER "\%$node->{NodeType} $node->{astNodeName}\% $kid->{NodeType} $kid->{astNodeName}\n";
 199                               },
 200                         sub { print SWIG_HEADER  "3 @_ \n";  }
 201                       );
 202 }
 203
 204
 205
 206 # Returns string representing $child method declaration or definition.
 207 # $child is the method node for which the code should be generated,
 208 # $parentName is the name of the parent for which the code should be generated,
 209 #             this is one is tricky, the reason for it is that $child node belongs
 210 #             to some class e.g. QWidget and we want to generate a code for $child
 211 #             but in a class called QWidget_bridge therefore we need to pass tha name
 212 # $mangleProtected will mangle the name of the method to look like normalNameProtected
 213 # $definition - if set the code generated will be a definition (without the opening
 214 #               and closing {} )
 215 sub generateMethodsCode($$$;$$)
 216 {
 217   my ($child, $parentName, $mangleProtected, $definition, $inline ) = @_;
 218
 219   my $ret = "";
 220
 221   if ( !(defined $definition) ) {
 222     if (  $child->{Flags} =~ "s" ) {
 223       $ret = "\tstatic ";
 224     } elsif ( $child->{Flags} =~ "v"  )  {
 225       $ret = "\tvirtual ";
 226     } else {
 227       $ret = "\t";
 228     }
 229   }
 230   if ( defined $definition  && !(defined $inline)) {
 231     if ( $mangleProtected ) {
 232       $ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}Protected";
 233     } else {
 234       $ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}";
 235     }
 236   } else {
 237     if ( defined $inline ) {
 238       $ret .= "\t";
 239     }
 240     if ( $mangleProtected ) {
 241       $ret .="$child->{ReturnType} $child->{astNodeName}Protected";
 242     } else {
 243               $ret .= convertType($child->{ReturnType})." $child->{astNodeName}";
 244    }
 245   }
 246   $ret .= "(";
 247   #$ret .= " $child->{Params} "; #can't be used because it includes names and default values
 248   my @params = $child->{ParamList};
 249   foreach my $arg (@params) {
 250     if ( $arg ) {
 251       my @arr = @{$arg};
 252       my $num = @arr;
 253       my $defParam = 'a';
 254       foreach my $param ( @{$arg} ) {
 255         #print "Node: $param->{ArgType} is a $param->{NodeType}\n";
 256         # if ($param->{NodeType} eq "enum" ) {
 257         #fix up enums
 258         #       $ret .= $parentName."::".$param->{astNodeName};
 259         #}
 260         #else{
 261         $ret .= convertType($param->{ArgType})." ";
 262         #}
 263         # Apparently some languages do not appreciate the names and default values
 264         ## FIXME: generate argument names for functions that do not have them
 265         if ( ! $param->{ArgName} ) {
 266           $param->{ArgName} = $defParam++;
 267           $ret .= $param->{ArgName};
 268         } else {
 269           $ret .= " $param->{ArgName}";
 270         }
 271         # For some reason we are not getting all of these...
 272         #if ( ! (defined $definition) ) {
 273         #  $ret .= "=$param->{DefaultValue}" if $param->{DefaultValue};
 274         #}
 275         --$num;
 276         $ret .= ", " if $num;
 277       }
 278     }
 279   }
 280   $ret .= ")";
 281   if ( $child->{Flags} =~ "c"  ) {
 282     $ret .= " const";
 283   }
 284   if ( defined $definition ) {
 285     $ret .= "\n";
 286   } else {
 287     $ret .= ";\n";
 288   }
 289 }
 290
 291 sub normalMethodDeclarations($$;$&$)
 292 {
 293   my ($node, $parentName, $definition, $writerSub, $inline) = @_;
 294   my $accessType = "";
 295     my $defaultConstructor = 0;
 296     my $hasPublicProtectedConstructor = 0;
 297     my $hasDestructor = 1;
 298     my $hasPublicDestructor = 1;
 299     my $hasCopyConstructor = 0;
 300     my $hasPrivateCopyConstructor = 1;
 301     my $enums = "";
 302
 303   my @methods;
 304
 305   my $ret = "";
 306
 307   Iter::MembersByType ( $node, undef,
 308                         sub {   my ($classNode, $methodNode ) = @_;
 309                                 if ( $methodNode->{NodeType} eq "method" ||
 310                                      $methodNode->{NodeType} eq "enum" ||
 311                                      $methodNode->{NodeType} eq "typedef" ) {
 312                                   if ( $methodNode->{Access} ne "protected" &&
 313                                        $methodNode->{Access} ne "protected_slots" &&
 314                                        #$methodNode->{Access} eq "private" &&
 315                                        $methodNode->{Access} ne "private_slots" &&
 316                                        $methodNode->{Access} ne "signals"  &&
 317                                        !$methodNode->{Pure}  &&
 318                                         $methodNode->{astNodeName} !~ /qt_/ &&
 319                                         $methodNode->{astNodeName} !~ /operator/ &&
 320                                         $methodNode->{Params} !~ /std\:\:/ &&
 321                                         $methodNode->{Params} !~ /\.\.\./){
 322                                     push @methods, $methodNode;
 323                                   }
 324                                 }
 325                               }, undef );
 326
 327   foreach my $child ( @methods ) {
 328     if ( $child->{Access} ne $accessType ) {
 329       $accessType = $child->{Access};
 330
 331       if ( ! (defined $definition ) ) {
 332         if ( $accessType eq "public_slots" ) {
 333           $ret .= "public: //slots\n";
 334         } else  {
 335           $ret .= "$accessType:\n";
 336         }
 337       }
 338     }
 339         ## check for private ctor, dtor or copy ctor...
 340 #       print " public $node->{astNodeName}, $child->{astNodeName}\n";
 341         if ( $node->{astNodeName} eq $child->{astNodeName} ) {
 342 #               print "Constructor...";
 343                 if ( $child->{ReturnType} =~ /~/  ) {
 344                 # A destructor
 345                 $hasPublicDestructor = 0 if $child->{Access} ne 'public';
 346                 $hasDestructor = 1;
 347                 } else {
 348                         if ( $child->{Params} eq '' && $child->{Access} ne 'private'){
 349                         # A constructor
 350                                 $defaultConstructor = 1;
 351                         }
 352                 }
 353 #               $hasPublicProtectedConstructor = 1 if ( $child->{Access} ne 'private' );
 354
 355                 # Copy constructor?
 356                 if ( $#{$child->{ParamList}} == 0 ) {
 357                         my $theArgType = @{$child->{ParamList}}[0]->{ArgType};
 358                         if ($theArgType =~ /$parentName\s*\&/) {
 359                         $hasCopyConstructor = 1;
 360                         $hasPrivateCopyConstructor = 1 if ( $child->{Access} eq 'private' );
 361                         }
 362                 }
 363                 # Hack the return type for constructors, since constructors return an object pointer
 364                 #$child->{ReturnType} = $node->{astNodeName}."*";
 365
 366         }
 367
 368         if( $child->{NodeType} eq "enum"){
 369                 $ret .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
 370                 $enums .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
 371         }
 372         else{
 373                 if ( $child->{NodeType} eq "typedef"){
 374                         $ret .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
 375                         $enums .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
 376                 }
 377                 else{
 378                         $ret .= generateMethodsCode( $child, $parentName, 0, $definition, $inline );
 379                 }
 380         }
 381
 382     if ( defined $definition && defined $writerSub ) {
 383       if ( defined $inline ) { $ret .= "\t"; }
 384       $ret .= "{\n";
 385       $ret .= &$writerSub( $child );
 386       if ( defined $inline ) { $ret .= "\t"; }
 387       $ret .= "}\n";
 388     }
 389
 390   }
 391
 392      if ( $defaultConstructor == 0)
 393      {
 394         #print "Private ctor for $node->{astNodeName}\n";
 395         $ret .= "private:\n\t";
 396         $ret .= $node->{astNodeName}."();\n";
 397      }
 398
 399      if ( $hasCopyConstructor == 1 && $hasPrivateCopyConstructor == 1)
 400      {
 401         #print "Private copy ctor for $node->{astNodeName}\n";
 402         $ret .= "private:\n\t";
 403         $ret .= $node->{astNodeName}."(const ".$node->{astNodeName}."& );\n";
 404      }
 405
 406      if ( $hasPublicDestructor == 0)
 407      {
 408         #print "Private dtor for $node->{astNodeName}\n";
 409         $ret .= "private:\n\t";
 410         $ret .= "~".$node->{astNodeName}."();\n";
 411      }
 412
 413      if ( $enums ne "")
 414      {
 415         print "inlineing enums...\n";
 416         $ret .= "\n\n%{\n";
 417         $ret .= $enums;
 418         $ret .= "%}\n";
 419      }
 420   return $ret;
 421 }
 422
 423 sub definitionParentWriter
 424 {
 425   my ($child) = @_;
 426   my $ret = "\t\t$child->{Parent}->{astNodeName}::$child->{astNodeName}\( ";
 427   $ret .= pureParamNames( $child );
 428   $ret .= ");\n";
 429
 430   return $ret;
 431 }
 432
 433 sub bridgeWriter
 434 {
 435   my ($child) = @_;
 436   my $ret = "\t\t$child->{astNodeName}Protected\( ";
 437   $ret .= pureParamNames( $child );
 438   $ret .= ");\n";
 439
 440   return $ret;
 441
 442 }
 443
 444 # returns a list of parameter names for $method in the form:
 445 # "a,b,c,d", suitable to call another method with the same
 446 # parameters
 447 sub pureParamNames($)
 448 {
 449   my $method = shift;
 450   my $ret = "";
 451
 452   my @params = $method->{ParamList};
 453   foreach my $arg (@params) {
 454     if ( $arg ) {
 455       my @arr = @{$arg};
 456       my $num = @arr;
 457       foreach my $param ( @{$arg} ) {
 458         $ret .= " $param->{ArgName}";
 459         --$num;
 460         $ret .= ", " if $num;
 461       }
 462     }
 463   }
 464   return $ret;
 465 }
 466
 467 sub mangledProtectedDeclarations($$$;$$$)
 468 {
 469   my ($node, $parentName, $mangle, $definition, $writerSub, $inline) = @_;
 470   my $accessType = "";
 471
 472   my @methods;
 473
 474   my $ret = "";
 475
 476   Iter::MembersByType ( $node, undef,
 477                         sub {   my ($classNode, $methodNode ) = @_;
 478
 479                                 if ( $methodNode->{NodeType} eq "method" ) {
 480                                   if ( $methodNode->{Access} eq "protected" ||
 481                                        $methodNode->{Access} eq "protected_slots" ) {
 482                                     push @methods, $methodNode;
 483                                   }
 484                                 }
 485                               }, undef );
 486
 487   foreach my $child ( @methods ) {
 488     if ( $child->{Access} ne $accessType ) {
 489       $accessType = $child->{Access};
 490
 491       if ( ! (defined $definition ) ) {
 492         if ( $accessType eq "protected_slots" ) {
 493           $ret .= "protected: //slots\n";
 494         } else  {
 495           $ret .= "$accessType:\n";
 496         }
 497       }
 498     }
 499     $ret .= generateMethodsCode( $child, $parentName, $mangle, $definition, $inline );
 500     if ( defined $definition && defined $writerSub ) {
 501       if ( defined $inline ) { $ret .= "\t"; }
 502       $ret .= "{\n";
 503       #FIXME : from which of the parents does the method come from?
 504       $ret .= &$writerSub( $child );
 505       if ( defined $inline ) { $ret .= "\t"; }
 506       $ret .= "}\n";
 507     }
 508   }
 509   return $ret;
 510 }
 511
 512 sub neededImportsForObject($)
 513 {
 514   my ($node) = @_;
 515 #  our @imports;
 516    my @imports;
 517    Iter::MembersByType ( $node,
 518                         sub {  },
 519                         sub {   my ($node, $kid ) = @_;
 520                                 if ( $kid->{NodeType} eq "method" &&
 521                                         $kid->{Access} eq "public" &&
 522                                         $kid->{astNodeName} !~ /qt_/
 523                                         ) {
 524                                   #print "Method: $kid->{ReturnType} $kid->{astNodeName}\n";
 525
 526                                   my @params = $kid->{ParamList};
 527                                   foreach my $arg (@params) {
 528                                     if ( $arg ) {
 529                                       foreach my $param ( @{$arg} ) {
 530                                         my $pname = convertType($param->{ArgType});
 531                                         if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
 532                                              $pname =~ /\bQ[A-Za-z0-9_]+/ &&
 533                                              $& ne $node->{astNodeName}
 534                                              ) {
 535                                           push @imports, checkObj($&);
 536                                           #print "Adding $&\n";
 537                                         }
 538                                       }
 539                                     }
 540                                   }
 541                                   my $pname = convertType($kid->{ReturnType});
 542                                         if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
 543                                              $pname =~ /\bQ[A-Za-z0-9_]+/ &&
 544                                              $& ne $node->{astNodeName}
 545                                              ) {
 546                                           push @imports, checkObj($&);
 547                                           #print "Adding $&\n";
 548                                         }
 549                                 }
 550                               },
 551                         sub { }
 552                       );
 553   my %seen = ();
 554   my @uniq;
 555   foreach my $item (@imports) {
 556     push(@uniq, $item) unless $seen{$item}++;
 557   }
 558   return @uniq;
 559 }
 560
 561 sub convertType($)
 562 {
 563         my ($item) = @_;
 564         #print "-$item-\n";
 565         if (exists $typedeflist{$item}) {
 566                 print "$item change to $typedeflist{$item}\n";
 567                 return $typedeflist{$item};
 568         } else {
 569                 return $item;
 570         }
 571 }
 572
 573 sub checkObj($)
 574 {
 575
 576         my ($item) = @_;
 577         # Yes some of this is in kalyptusDataDict's ctypemap
 578 # but that one would need to be separated (builtins vs normal classes)
 579
 580         my $node = kdocAstUtil::findRef( $rootnode, $item );
 581         #print "Data item $item is a $node->{Access} node $node->{astNodeName}\n";
 582         return $node->{astNodeName};
 583
 584 }
 585 sub generateNeededTemplatesForObject($)
 586 {
 587   my ($node) = @_;
 588
 589   Iter::MembersByType ( $node,
 590                         sub {  },
 591                         sub {   my ($node, $kid ) = @_;
 592                                 if ( $kid->{NodeType} eq "method" ) {
 593                                   my @params = $kid->{ParamList};
 594                                   foreach my $arg (@params) {
 595                                     if ( $arg ) {
 596                                       foreach my $param ( @{$arg} ) {
 597                                         my $pname = $param->{ArgType};
 598                                         if ( $pname =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
 599                                           my $cname = $1;
 600                                           my $tname = $2;
 601                                           if ( $tname eq "type" || $tname eq "T"){
 602                                                 $tname = "int";
 603                                           }else{
 604                                           print "Template $1::$2 in $pname\n";
 605                                           print SWIG_HEADER "\%template($tname",$cname,")   $cname"."<",$tname,">;\n";
 606                                           }
 607                                         }
 608                                       }
 609                                     }
 610                                   }
 611                                   my $returnName = $kid->{ReturnType};
 612                                   if ( $returnName =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
 613                                     my $cname = $1;
 614                                     my $tname = $2;
 615                                     if ( $tname eq "type" || $tname eq "T"){
 616                                                 $tname = "int";
 617                                          #}else{
 618                                           print "Template $1::$2 in $returnName\n";
 619                                           print SWIG_HEADER "\%template($tname",$cname,")   $cname"."<",$tname,">;\n";
 620                                           }
 621
 622                                   }
 623                                 }
 624                               },
 625                         sub { }
 626                       );
 627 }
 628
 629 sub generateHeader($$)
 630 {
 631   my ($node, $filename) = @_;
 632
 633   open ( HEADER, ">$outputdir/$filename" ) || die "Can't open header $filename\n";
 634   print HEADER documentationHeader( $filename, "header file" );
 635
 636   my $macro = uc $filename;
 637   $macro =~ s/\./_/g;
 638   print HEADER "#ifndef ", $macro, "\n";
 639   print HEADER "#define ", $macro, "\n";
 640
 641   print HEADER "class $node->{astNodeName}Bridge;\n";
 642   my @parentNames = parentClassNames($node);
 643   my $len = @parentNames;
 644   if ( $len ) {
 645     print HEADER "\n";
 646     print HEADER "$node->{NodeType} ",$typeprefix,$node->{astNodeName}," ";
 647     my $idx = 0;
 648     my $start = 0;
 649     while ( $len-- ) {
 650       if ( $len ) {
 651         if ($parentNames[$idx] ) {
 652           if ( !$start ) {
 653             print HEADER ": ";
 654             $start = 1;
 655           }
 656           print HEADER " public ",$typeprefix,"$parentNames[$idx],\n\t" if $parentNames[$idx];
 657         }
 658       } else {
 659         if ($parentNames[$idx] ) {
 660           if ( !$start ) {
 661             print HEADER ": ";
 662             $start = 1;
 663           }
 664           print HEADER " public ",$typeprefix,"$parentNames[$idx]\n" if $parentNames[$idx];
 665         }
 666       }
 667       ++$idx;
 668     }
 669   } else {
 670     print HEADER "$node->{NodeType} $node->{astNodeName} ";
 671   }
 672   print HEADER "{\n";
 673   print HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
 674   my $prot = mangledProtectedDeclarations( $node, $typeprefix + $node->{NodeType}, 0 );
 675   $prot =~ s/protected\:/public\:/g;
 676   print HEADER $prot;
 677   print HEADER "private:\n";
 678   print HEADER "\t$node->{astNodeName}Bridge *mBridge;\n";
 679   print HEADER "};\n\n";
 680   print HEADER "#endif //", uc $filename, "\n";
 681   close HEADER;
 682 }
 683
 684 sub generateBridge($*)
 685 {
 686   my($node, $fh) = @_;
 687
 688   print $fh "$node->{NodeType} $node->{astNodeName}Bridge : public $node->{astNodeName}\n";
 689   print $fh "{\n";
 690   #  print $fh "public:\n";
 691   #  print $fh normalMethodDeclarations( $node, $node->{astNodeName}."Bridge" , 1, sub { definitionParentWriter(@_) }, 1 );
 692   print $fh "public:\n";
 693   print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 1, 1, sub { definitionParentWriter(@_) }, 1 );
 694   print $fh "protected:\n";
 695   print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 0, 1, sub { bridgeWriter(@_) }, 1 );
 696   print $fh "\n";
 697   print $fh "\n";
 698   print $fh "};\n";
 699
 700 }
 701
 702 sub generateWrapper($*)
 703 {
 704   my($node, $fh) = @_;
 705
 706 }
 707
 708 sub generateSource
 709 {
 710   my ($node, $filename) = @_;
 711
 712   open ( SOURCE, ">$outputdir/$filename" ) || die "Can't open $filename\n";
 713
 714   $filename =~ s/\.cpp$/\.h/;
 715   print SOURCE "#include \"$filename\";\n\n\n";
 716
 717   generateBridge( $node, *SOURCE );
 718   generateWrapper( $node, *SOURCE );
 719
 720   close SOURCE;
 721 }
 722
 723 sub protectedMethods($)
 724 {
 725
 726 }
 727
 728 sub documentationHeader($$)
 729 {
 730   my ($file, $descr) = @_;
 731   my $ret = "/***************************************************************************\n";
 732   $ret   .= "    File:  $file -  $descr\n";
 733   $ret   .= $docTop;
 734   return $ret;
 735 }
 736
 737 sub writeDoc
 738 {
 739   ( $lib, $rootnode, $outputdir, $opt ) = @_;
 740
 741   $debug = $main::debuggen;
 742
 743   mkpath( $outputdir ) unless -f $outputdir;
 744   unlink $outputdir."/interfaces_all.i";
 745
 746   # Document all compound nodes
 747   Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
 748 }
 749
 750
 751 sub addInterface($$$)
 752 {
 753   my ($outputdir,$typeprefix,$node) = @_;
 754   my $interfacesFile = "interfaces_all.i";
 755   open( IFILE, ">>$outputdir/$interfacesFile" ) || die "Can't open $outputdir/$interfacesFile";
 756   print IFILE "%include \"$typeprefix", kdocAstUtil::heritage($node),".i\"\n";
 757   close IFILE;
 758 }
 759
 760
 761 sub writeClassDoc
 762 {
 763   my( $node ) = @_;
 764
 765   if( exists $node->{ExtSource} ) {
 766     print "Trying to write doc for ".$node->{AstNodeName}.
 767       " from ".$node->{ExtSource}."\n";
 768     return;
 769   }
 770
 771   if( $node->{Access} eq "private" ||
 772       $node->{Access} eq "protected" ) {
 773     return;
 774   }
 775
 776   my $typeName = $node->{astNodeName}."*";
 777
 778   if ( kalyptusDataDict::ctypemap($typeName) eq "" ) {
 779     $typeprefix = ($typeName =~ /^Q/ ? "qt_" : "kde_");
 780     kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
 781     print "'$typeName' => '$typeprefix$typeName',\n";
 782   } elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
 783     $typeprefix = "qt_";
 784   } elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/ ) {
 785                 $typeprefix = "kde_";
 786               } else {
 787                 $typeprefix = "kde_";
 788               }
 789
 790   my $basefile =  "$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
 791   my $cppfile =  $basefile;
 792   $cppfile =~ s/\.i/_wrap\.cpp/;
 793
 794
 795   my $file = "$outputdir/$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
 796   my $docnode = $node->{DocNode};
 797   my @list = ();
 798   my $version = undef;
 799   my $author = undef;
 800
 801   addInterface( $outputdir, $typeprefix, $node );
 802
 803   #     if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private" || exists $node->{Tmpl} ) {
 804   if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") {
 805     return;
 806   }
 807
 808   open( SWIG_HEADER, ">$file" ) || die "Couldn't create $file\n";
 809
 810   # Header
 811
 812   my $short = "";
 813   my $extra = "";
 814
 815   my $f = $typeprefix . $node->{astNodeName} . ".h";
 816   my $descr = documentationHeader( $f, "header" );
 817   print SWIG_HEADER $descr;
 818
 819   generateHeader( $node, $f );
 820   $f =~ s/\.h$/\.cpp/;
 821   generateSource( $node, $f );
 822
 823   if ( defined $docnode ) {
 824     print SWIG_HEADER "/**\n";
 825     if ( defined $docnode->{Text} ) {
 826       my $node;
 827       foreach $node ( @{$docnode->{Text}} ) {
 828         next if $node->{NodeType} ne "DocText";
 829         print SWIG_HEADER $node->{astNodeName}, "\n";
 830       }
 831     }
 832
 833     exists $docnode->{Author} && print SWIG_HEADER " \@author ", $docnode->{Author}, "\n";
 834     exists $docnode->{Version} && print SWIG_HEADER " \@version ", $docnode->{Version}, "\n";
 835     exists $docnode->{ClassShort} && print SWIG_HEADER " \@short ", $docnode->{ClassShort}, "\n";
 836     print SWIG_HEADER "*/\n";
 837   }
 838
 839   my $sourcename = $node->{Source}->{astNodeName};
 840
 841   if ( $sourcename =~ m!.*(dom|kabc|kdeprint|kdesu|kio|kjs|kparts|ktexteditor|libkmid)/([^/]*$)! ) {
 842     $sourcename = $1."/".$2;
 843   } else {
 844     $sourcename =~ s!.*/([^/]*$)!$1!;
 845   }
 846
 847   print SWIG_HEADER "\%module ",$typeprefix,$node->{astNodeName},"\n\n";
 848
 849   print SWIG_HEADER "\%{\n#include <",$sourcename , ">\n\%}\n\n";
 850
 851   #print SWIG_HEADER "\%import \"interfaces_all.i\"\n";
 852
 853   #print SWIG_HEADER "\%import \"", $basefile ,"\"\n";
 854
 855   # make this smarter i guess...
 856 #  my @types = neededImportsForObject($node);
 857 #  foreach my $f ( @types ) {
 858 #         print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
 859 #  }
 860 #  print SWIG_HEADER "\%import \"qt_Qt.i\"\n";
 861
 862 #  my @impor = parentClassNames($node);
 863 #  foreach my $f ( @impor ) {
 864 #         print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
 865 #  }
 866
 867   #     Iter::LocalCompounds( $node, sub { my ($node) = @_; print STDERR "$node->{NodeType}||$node->{astNodeName} \n"; } );
 868   #     Iter::Generic( $node, undef,
 869   #                    &isNotProtectedMethod,
 870   #                    sub { my ($node, $kid) = @_; debugPrint "This is :: ", $node->{astNodeName}, " | ", $kid->{astNodeName}, "\n"; },
 871   #                    undef );
 872   #     Iter::MembersByType ( $node, undef,
 873   #                   sub {     my ($classNode, $methodNode ) = @_;
 874   #
 875   #                             if ( $methodNode->{NodeType} eq "method" ) {
 876   #                               print SWIG_HEADER generateMethodsCode( $methodNode, 0 );
 877   #                             }
 878   #                           }, undef );
 879
 880   my @parentNames = parentClassNames($node);
 881   my $len = @parentNames;
 882   if ( $len ) {
 883     print SWIG_HEADER "\n";
 884     print SWIG_HEADER "$node->{NodeType} ",$node->{astNodeName}," ";
 885     my $idx = 0;
 886     my $start = 0;
 887     while ( $len-- ) {
 888       if ( $len ) {
 889         if ($parentNames[$idx] ) {
 890           if ( !$start ) {
 891             print SWIG_HEADER ": ";
 892             $start = 1;
 893           }
 894                 print SWIG_HEADER " public $parentNames[$idx],\n\t" if $parentNames[$idx];
 895         }
 896       } else {
 897         if ($parentNames[$idx] ) {
 898           if ( !$start ) {
 899                   print SWIG_HEADER ": ";
 900                   $start = 1;
 901                 }
 902           print SWIG_HEADER " public $parentNames[$idx]\n" if $parentNames[$idx];
 903         }
 904       }
 905       ++$idx;
 906     }
 907   } else {
 908     print SWIG_HEADER "$node->{NodeType} $node->{astNodeName} ";
 909   }
 910   print SWIG_HEADER "{\n";
 911 #  my $name = $node->{astNodeName}."Bridge";
 912 #  print SWIG_HEADER normalMethodDeclarations( $node, $name, 1 );
 913   print SWIG_HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
 914   print SWIG_HEADER "};\n\n\n";
 915
 916
 917 #  generateNeededTemplatesForObject( $node );
 918   print SWIG_HEADER "\n";
 919
 920   #print SWIG_HEADER "\%inline \%{\n\n";
 921
 922   #print SWIG_HEADER "class ",$node->{astNodeName},";\n";
 923   #print SWIG_HEADER "#include <",$sourcename , ">\n";
 924   #print SWIG_HEADER $node->{astNodeName}, " *",$node->{astNodeName},"Null()\n";
 925   #print SWIG_HEADER "{\n";
 926   #print SWIG_HEADER "\treturn ($node->{astNodeName}*)0L;\n";
 927   #print SWIG_HEADER "}\n\n";
 928   #print SWIG_HEADER "\%}\n";
 929
 930   $constructorCount = 0;
 931
 932   #     Iter::MembersByType ( $node,
 933   #             sub { print SWIG_HEADER "", $_[0], ""; },
 934   #             sub {   my ($node, $kid ) = @_;
 935   #                 preParseMember( $node, $kid );
 936   #               },
 937   #             sub { print SWIG_HEADER ""; }
 938   #     );
 939
 940   #     if ( ! exists $node->{Pure} && $constructorCount > 0 ) {
 941   #             print SWIG_HEADER "CLASS HEADER = class ", $node->{astNodeName}, "Bridge : public ", kalyptusDataDict::addNamespace($node->{astNodeName}), "\n{\npublic:\n";
 942
 943   #             Iter::MembersByType ( $node,
 944   #                     sub { print SWIG_HEADER "", $_[0], ""; },
 945   #                     sub {   my ($node, $kid ) = @_;
 946   #                    generateBridgeClass( $node, $kid );
 947   #                 },
 948   #                     sub { print SWIG_HEADER ""; }
 949   #                     );
 950
 951   #             generateBridgeEventHandlers($node);
 952   #     }
 953
 954   %functionId = ();
 955   $eventHandlerCount = 0;
 956
 957   #     Iter::MembersByType ( $node,
 958   #             sub { print SWIG_HEADER "", $_[0], ""; },
 959   #             sub {   my ($node, $kid ) = @_;
 960   #                               listMember( $node, $kid );
 961   #                         },
 962   #             sub { print SWIG_HEADER ""; }
 963   #     );
 964
 965   # ancestors
 966   #     my @ancestors = ();
 967   #     Iter::Ancestors( $node, $rootnode, undef, undef,
 968   #             sub { # print
 969   #                     my ( $ances, $name, $type, $template ) = @_;
 970   #
 971   #                     push @ancestors, $name;
 972   #
 973   #             },
 974   #             undef
 975   #     );
 976
 977   #     if ( $#ancestors > 0 ) {
 978   #             # 'type transfer' functions to cast for correct use of multiple inheritance
 979   #             foreach my $ancestor (@ancestors) {
 980   #                     print SWIG_HEADER "\n/\*\* Casts a '$typeprefix", $node->{astNodeName}, " *' to a '", kalyptusDataDict::ctypemap($ancestor."\*"), "' \*/\n";
 981   #                     print SWIG_HEADER kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
 982   #                     print SWIG_HEADER "(", $typeprefix, $node->{astNodeName}, "* instPointer);\n";
 983
 984   #                     print CLASS kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
 985   #                     print CLASS "(", $typeprefix, $node->{astNodeName}, "* instPointer){\n";
 986   #                     print CLASS "\treturn (", kalyptusDataDict::ctypemap($ancestor."\*"), ") (", $ancestor, " *) (", $node->{astNodeName}, " *) instPointer;\n}\n";
 987   #             }
 988   #     }
 989
 990   close SWIG_HEADER;
 991 }
 992
 993 ###################################################################################
 994
 995 1;
 996