You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
libtqt-perl/kalyptus/kalyptusCxxToSwig.pm

997 lines
27 KiB

package kalyptusCxxToSwig;
use File::Path;
use File::Basename;
use Carp;
use Ast;
use kdocAstUtil;
use kdocUtil;
use Iter;
use kalyptusDataDict;
use strict;
no strict "subs";
use vars qw/ @clist $host $who $now $gentext %functionId $docTop %typedeflist
$lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount
$constructorCount *CLASS *HEADER *TQTCTYPES *KDETYPES /;
BEGIN
{
@clist = ();
%typedeflist =
(
'signed char' => 'char',
'unsigned char' => 'uchar',
'signed short' => 'short',
'unsigned short' => 'ushort',
'signed' => 'int',
'signed int' => 'int',
'unsigned' => 'uint',
'unsigned int' => 'uint',
'signed long' => 'long',
'unsigned long' => 'ulong',
'TQWSEvent*' => 'void*',
'TQDiskFont*' => 'void*',
'XEvent*' => 'void*',
'TQStyleHintReturn*' => 'void*',
'FILE*' => 'void*',
'TQUnknownInterface*' => 'void*',
'GDHandle' => 'void*',
'_NPStream*' => 'void*',
'TQTextFormat*' => 'void*',
'TQTextDocument*' => 'void*',
'TQTextCursor*' => 'void*',
'TQTextParag**' => 'void*',
'TQTextParag* *' => 'void*',
'TQTextParag*' => 'void*',
'TQRemoteInterface*' => 'void*',
'TQSqlRecordPrivate*' => 'void*',
'TQTSMFI' => 'void*', # TQTextStream's TQTSManip
'const GUID&' => 'void*',
'TQWidgetMapper*' => 'void*',
'TQWidgetMapper *' => 'void*',
'MSG*' => 'void*',
'const TQSqlFieldInfoList&' => 'void*', # TQSqlRecordInfo - TODO (templates)
'TQPtrCollection::Item' => 'void*', # to avoid a warning
'mode_t' => 'long',
'TQProcess::PID' => 'long',
'size_type' => 'int', # TQSqlRecordInfo
'TQt::ComparisonFlags' => 'uint',
'TQt::ToolBarDock' => 'int', # compat thing, Qt shouldn't use it
'TQIODevice::Offset' => 'ulong',
'WState' => 'int',
'WId' => 'ulong',
'TQRgb' => 'uint',
'TQRgb *' => 'uint*',
'TQRgb*' => 'uint*',
'const TQCOORD*' => 'const int*',
'TQCOORD*' => 'int*',
'TQCOORD' => 'int',
'TQCOORD &' => 'int&',
'TQTSMFI' => 'int',
'TQt::WState' => 'int',
'TQt::WFlags' => 'int',
'TQt::HANDLE' => 'uint',
'TQEventLoop::ProcessEventsFlags' => 'uint',
'TQStyle::SCFlags' => 'int',
'TQStyle::SFlags' => 'int',
'TQStyleOption&' => 'int&',
'const TQStyleOption&' => 'const int&',
'TQ_INT16' => 'short',
'TQ_INT32' => 'int',
'TQ_INT8' => 'char',
'TQ_LONG' => 'long',
'TQ_UINT16' => 'ushort',
'TQ_UINT32' => 'uint',
'TQ_UINT8' => 'uchar',
'TQ_ULONG' => 'long',
);
# Page footer
$who = kdocUtil::userName();
$host = kdocUtil::hostName();
$now = localtime;
$gentext = "$who\@$host on $now, using kalyptus $main::Version.";
$docTop =<<EOF
begin : $now
copyright : (C) 2003 Ian Geiser, Zack Rusin
email : geiseri\@kde.org, zack\@kde.org
generated by : $gentext
***************************************************************************/
/***************************************************************************
* *
* This library is free software; you can redistribute it and/or modify *
* it under the terms of the GNU Library General Public License as *
* published by the Free Software Foundation; either version 2 of the *
* License, or (at your option) any later version. *
* *
***************************************************************************/
EOF
}
# Returns 1 if the $kid of the $node should be skipped
sub skipMethod($$)
{
my ($node, $kid) = @_;
if ( $kid->{NodeType} ne "method" ) {
return 1;
}
my $access = $kid->{Access};
# if ( $access eq "private" || $access eq "private_slots" || $access eq "signals" ) {
if ( $access eq "private_slots" || $access eq "signals" ) {
return 1;
}
return undef;
}
# returns 1 if the $kid is not a protected method of object $node
sub isNotProtectedMethod($$)
{
my ($node, $kid) = @_;
print "HERE $node->{NodeType} $node->{astNodeName}, $kid->{NodeType} $kid->{astNodeName} \n";
if ( $kid->{NodeType} ne "method" ) {
return 1;
}
my $access = $kid->{Access};
if ( $access ne "protected" && $access ne "protected_slots" ) {
return 1;
}
return undef;
}
# Returns the list of all classes this one inherits
# If $recurse is defined function returns also all the parents
# of the classes $classNode inherits from
sub superClassList($;$)
{
my $classNode = shift;
my $recurse = shift;
my @super;
my @nodes;
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
push @super, @_[0];
if ( defined $recurse ) {
push @super, superClassList( @_[0] );
}
}, undef );
return @super;
}
# Returns the names of the classes the $classNode
# inherits from
sub parentClassNames($)
{
my $classNode = shift;
my @names;
my @supers = superClassList($classNode);
foreach my $class (@supers) {
push @names, $class->{astNodeName};
}
return @names;
}
#doesn't do anything, for me to test
sub hasPublicConstructors($)
{
my ($node) = @_;
our $exists;
Iter::MembersByType ( $node,
sub { print SWIG_HEADER "1) @_\n"; },
sub { my ($node, $kid ) = @_;
print SWIG_HEADER "\%$node->{NodeType} $node->{astNodeName}\% $kid->{NodeType} $kid->{astNodeName}\n";
},
sub { print SWIG_HEADER "3 @_ \n"; }
);
}
# Returns string representing $child method declaration or definition.
# $child is the method node for which the code should be generated,
# $parentName is the name of the parent for which the code should be generated,
# this is one is tricky, the reason for it is that $child node belongs
# to some class e.g. TQWidget and we want to generate a code for $child
# but in a class called TQWidget_bridge therefore we need to pass tha name
# $mangleProtected will mangle the name of the method to look like normalNameProtected
# $definition - if set the code generated will be a definition (without the opening
# and closing {} )
sub generateMethodsCode($$$;$$)
{
my ($child, $parentName, $mangleProtected, $definition, $inline ) = @_;
my $ret = "";
if ( !(defined $definition) ) {
if ( $child->{Flags} =~ "s" ) {
$ret = "\tstatic ";
} elsif ( $child->{Flags} =~ "v" ) {
$ret = "\tvirtual ";
} else {
$ret = "\t";
}
}
if ( defined $definition && !(defined $inline)) {
if ( $mangleProtected ) {
$ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}Protected";
} else {
$ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}";
}
} else {
if ( defined $inline ) {
$ret .= "\t";
}
if ( $mangleProtected ) {
$ret .="$child->{ReturnType} $child->{astNodeName}Protected";
} else {
$ret .= convertType($child->{ReturnType})." $child->{astNodeName}";
}
}
$ret .= "(";
#$ret .= " $child->{Params} "; #can't be used because it includes names and default values
my @params = $child->{ParamList};
foreach my $arg (@params) {
if ( $arg ) {
my @arr = @{$arg};
my $num = @arr;
my $defParam = 'a';
foreach my $param ( @{$arg} ) {
#print "Node: $param->{ArgType} is a $param->{NodeType}\n";
# if ($param->{NodeType} eq "enum" ) {
#fix up enums
# $ret .= $parentName."::".$param->{astNodeName};
#}
#else{
$ret .= convertType($param->{ArgType})." ";
#}
# Apparently some languages do not appreciate the names and default values
## FIXME: generate argument names for functions that do not have them
if ( ! $param->{ArgName} ) {
$param->{ArgName} = $defParam++;
$ret .= $param->{ArgName};
} else {
$ret .= " $param->{ArgName}";
}
# For some reason we are not getting all of these...
#if ( ! (defined $definition) ) {
# $ret .= "=$param->{DefaultValue}" if $param->{DefaultValue};
#}
--$num;
$ret .= ", " if $num;
}
}
}
$ret .= ")";
if ( $child->{Flags} =~ "c" ) {
$ret .= " const";
}
if ( defined $definition ) {
$ret .= "\n";
} else {
$ret .= ";\n";
}
}
sub normalMethodDeclarations($$;$&$)
{
my ($node, $parentName, $definition, $writerSub, $inline) = @_;
my $accessType = "";
my $defaultConstructor = 0;
my $hasPublicProtectedConstructor = 0;
my $hasDestructor = 1;
my $hasPublicDestructor = 1;
my $hasCopyConstructor = 0;
my $hasPrivateCopyConstructor = 1;
my $enums = "";
my @methods;
my $ret = "";
Iter::MembersByType ( $node, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq "method" ||
$methodNode->{NodeType} eq "enum" ||
$methodNode->{NodeType} eq "typedef" ) {
if ( $methodNode->{Access} ne "protected" &&
$methodNode->{Access} ne "protected_slots" &&
#$methodNode->{Access} eq "private" &&
$methodNode->{Access} ne "private_slots" &&
$methodNode->{Access} ne "signals" &&
!$methodNode->{Pure} &&
$methodNode->{astNodeName} !~ /qt_/ &&
$methodNode->{astNodeName} !~ /operator/ &&
$methodNode->{Params} !~ /std\:\:/ &&
$methodNode->{Params} !~ /\.\.\./){
push @methods, $methodNode;
}
}
}, undef );
foreach my $child ( @methods ) {
if ( $child->{Access} ne $accessType ) {
$accessType = $child->{Access};
if ( ! (defined $definition ) ) {
if ( $accessType eq "public_slots" ) {
$ret .= "public: //slots\n";
} else {
$ret .= "$accessType:\n";
}
}
}
## check for private ctor, dtor or copy ctor...
# print " public $node->{astNodeName}, $child->{astNodeName}\n";
if ( $node->{astNodeName} eq $child->{astNodeName} ) {
# print "Constructor...";
if ( $child->{ReturnType} =~ /~/ ) {
# A destructor
$hasPublicDestructor = 0 if $child->{Access} ne 'public';
$hasDestructor = 1;
} else {
if ( $child->{Params} eq '' && $child->{Access} ne 'private'){
# A constructor
$defaultConstructor = 1;
}
}
# $hasPublicProtectedConstructor = 1 if ( $child->{Access} ne 'private' );
# Copy constructor?
if ( $#{$child->{ParamList}} == 0 ) {
my $theArgType = @{$child->{ParamList}}[0]->{ArgType};
if ($theArgType =~ /$parentName\s*\&/) {
$hasCopyConstructor = 1;
$hasPrivateCopyConstructor = 1 if ( $child->{Access} eq 'private' );
}
}
# Hack the return type for constructors, since constructors return an object pointer
#$child->{ReturnType} = $node->{astNodeName}."*";
}
if( $child->{NodeType} eq "enum"){
$ret .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
$enums .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
}
else{
if ( $child->{NodeType} eq "typedef"){
$ret .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
$enums .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
}
else{
$ret .= generateMethodsCode( $child, $parentName, 0, $definition, $inline );
}
}
if ( defined $definition && defined $writerSub ) {
if ( defined $inline ) { $ret .= "\t"; }
$ret .= "{\n";
$ret .= &$writerSub( $child );
if ( defined $inline ) { $ret .= "\t"; }
$ret .= "}\n";
}
}
if ( $defaultConstructor == 0)
{
#print "Private ctor for $node->{astNodeName}\n";
$ret .= "private:\n\t";
$ret .= $node->{astNodeName}."();\n";
}
if ( $hasCopyConstructor == 1 && $hasPrivateCopyConstructor == 1)
{
#print "Private copy ctor for $node->{astNodeName}\n";
$ret .= "private:\n\t";
$ret .= $node->{astNodeName}."(const ".$node->{astNodeName}."& );\n";
}
if ( $hasPublicDestructor == 0)
{
#print "Private dtor for $node->{astNodeName}\n";
$ret .= "private:\n\t";
$ret .= "~".$node->{astNodeName}."();\n";
}
if ( $enums ne "")
{
print "inlineing enums...\n";
$ret .= "\n\n%{\n";
$ret .= $enums;
$ret .= "%}\n";
}
return $ret;
}
sub definitionParentWriter
{
my ($child) = @_;
my $ret = "\t\t$child->{Parent}->{astNodeName}::$child->{astNodeName}\( ";
$ret .= pureParamNames( $child );
$ret .= ");\n";
return $ret;
}
sub bridgeWriter
{
my ($child) = @_;
my $ret = "\t\t$child->{astNodeName}Protected\( ";
$ret .= pureParamNames( $child );
$ret .= ");\n";
return $ret;
}
# returns a list of parameter names for $method in the form:
# "a,b,c,d", suitable to call another method with the same
# parameters
sub pureParamNames($)
{
my $method = shift;
my $ret = "";
my @params = $method->{ParamList};
foreach my $arg (@params) {
if ( $arg ) {
my @arr = @{$arg};
my $num = @arr;
foreach my $param ( @{$arg} ) {
$ret .= " $param->{ArgName}";
--$num;
$ret .= ", " if $num;
}
}
}
return $ret;
}
sub mangledProtectedDeclarations($$$;$$$)
{
my ($node, $parentName, $mangle, $definition, $writerSub, $inline) = @_;
my $accessType = "";
my @methods;
my $ret = "";
Iter::MembersByType ( $node, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq "method" ) {
if ( $methodNode->{Access} eq "protected" ||
$methodNode->{Access} eq "protected_slots" ) {
push @methods, $methodNode;
}
}
}, undef );
foreach my $child ( @methods ) {
if ( $child->{Access} ne $accessType ) {
$accessType = $child->{Access};
if ( ! (defined $definition ) ) {
if ( $accessType eq "protected_slots" ) {
$ret .= "protected: //slots\n";
} else {
$ret .= "$accessType:\n";
}
}
}
$ret .= generateMethodsCode( $child, $parentName, $mangle, $definition, $inline );
if ( defined $definition && defined $writerSub ) {
if ( defined $inline ) { $ret .= "\t"; }
$ret .= "{\n";
#FIXME : from which of the parents does the method come from?
$ret .= &$writerSub( $child );
if ( defined $inline ) { $ret .= "\t"; }
$ret .= "}\n";
}
}
return $ret;
}
sub neededImportsForObject($)
{
my ($node) = @_;
# our @imports;
my @imports;
Iter::MembersByType ( $node,
sub { },
sub { my ($node, $kid ) = @_;
if ( $kid->{NodeType} eq "method" &&
$kid->{Access} eq "public" &&
$kid->{astNodeName} !~ /qt_/
) {
#print "Method: $kid->{ReturnType} $kid->{astNodeName}\n";
my @params = $kid->{ParamList};
foreach my $arg (@params) {
if ( $arg ) {
foreach my $param ( @{$arg} ) {
my $pname = convertType($param->{ArgType});
if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
$pname =~ /\bQ[A-Za-z0-9_]+/ &&
$& ne $node->{astNodeName}
) {
push @imports, checkObj($&);
#print "Adding $&\n";
}
}
}
}
my $pname = convertType($kid->{ReturnType});
if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
$pname =~ /\bQ[A-Za-z0-9_]+/ &&
$& ne $node->{astNodeName}
) {
push @imports, checkObj($&);
#print "Adding $&\n";
}
}
},
sub { }
);
my %seen = ();
my @uniq;
foreach my $item (@imports) {
push(@uniq, $item) unless $seen{$item}++;
}
return @uniq;
}
sub convertType($)
{
my ($item) = @_;
#print "-$item-\n";
if (exists $typedeflist{$item}) {
print "$item change to $typedeflist{$item}\n";
return $typedeflist{$item};
} else {
return $item;
}
}
sub checkObj($)
{
my ($item) = @_;
# Yes some of this is in kalyptusDataDict's ctypemap
# but that one would need to be separated (builtins vs normal classes)
my $node = kdocAstUtil::findRef( $rootnode, $item );
#print "Data item $item is a $node->{Access} node $node->{astNodeName}\n";
return $node->{astNodeName};
}
sub generateNeededTemplatesForObject($)
{
my ($node) = @_;
Iter::MembersByType ( $node,
sub { },
sub { my ($node, $kid ) = @_;
if ( $kid->{NodeType} eq "method" ) {
my @params = $kid->{ParamList};
foreach my $arg (@params) {
if ( $arg ) {
foreach my $param ( @{$arg} ) {
my $pname = $param->{ArgType};
if ( $pname =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
my $cname = $1;
my $tname = $2;
if ( $tname eq "type" || $tname eq "T"){
$tname = "int";
}else{
print "Template $1::$2 in $pname\n";
print SWIG_HEADER "\%template($tname",$cname,") $cname"."<",$tname,">;\n";
}
}
}
}
}
my $returnName = $kid->{ReturnType};
if ( $returnName =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
my $cname = $1;
my $tname = $2;
if ( $tname eq "type" || $tname eq "T"){
$tname = "int";
#}else{
print "Template $1::$2 in $returnName\n";
print SWIG_HEADER "\%template($tname",$cname,") $cname"."<",$tname,">;\n";
}
}
}
},
sub { }
);
}
sub generateHeader($$)
{
my ($node, $filename) = @_;
open ( HEADER, ">$outputdir/$filename" ) || die "Can't open header $filename\n";
print HEADER documentationHeader( $filename, "header file" );
my $macro = uc $filename;
$macro =~ s/\./_/g;
print HEADER "#ifndef ", $macro, "\n";
print HEADER "#define ", $macro, "\n";
print HEADER "class $node->{astNodeName}Bridge;\n";
my @parentNames = parentClassNames($node);
my $len = @parentNames;
if ( $len ) {
print HEADER "\n";
print HEADER "$node->{NodeType} ",$typeprefix,$node->{astNodeName}," ";
my $idx = 0;
my $start = 0;
while ( $len-- ) {
if ( $len ) {
if ($parentNames[$idx] ) {
if ( !$start ) {
print HEADER ": ";
$start = 1;
}
print HEADER " public ",$typeprefix,"$parentNames[$idx],\n\t" if $parentNames[$idx];
}
} else {
if ($parentNames[$idx] ) {
if ( !$start ) {
print HEADER ": ";
$start = 1;
}
print HEADER " public ",$typeprefix,"$parentNames[$idx]\n" if $parentNames[$idx];
}
}
++$idx;
}
} else {
print HEADER "$node->{NodeType} $node->{astNodeName} ";
}
print HEADER "{\n";
print HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
my $prot = mangledProtectedDeclarations( $node, $typeprefix + $node->{NodeType}, 0 );
$prot =~ s/protected\:/public\:/g;
print HEADER $prot;
print HEADER "private:\n";
print HEADER "\t$node->{astNodeName}Bridge *mBridge;\n";
print HEADER "};\n\n";
print HEADER "#endif //", uc $filename, "\n";
close HEADER;
}
sub generateBridge($*)
{
my($node, $fh) = @_;
print $fh "$node->{NodeType} $node->{astNodeName}Bridge : public $node->{astNodeName}\n";
print $fh "{\n";
# print $fh "public:\n";
# print $fh normalMethodDeclarations( $node, $node->{astNodeName}."Bridge" , 1, sub { definitionParentWriter(@_) }, 1 );
print $fh "public:\n";
print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 1, 1, sub { definitionParentWriter(@_) }, 1 );
print $fh "protected:\n";
print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 0, 1, sub { bridgeWriter(@_) }, 1 );
print $fh "\n";
print $fh "\n";
print $fh "};\n";
}
sub generateWrapper($*)
{
my($node, $fh) = @_;
}
sub generateSource
{
my ($node, $filename) = @_;
open ( SOURCE, ">$outputdir/$filename" ) || die "Can't open $filename\n";
$filename =~ s/\.cpp$/\.h/;
print SOURCE "#include \"$filename\";\n\n\n";
generateBridge( $node, *SOURCE );
generateWrapper( $node, *SOURCE );
close SOURCE;
}
sub protectedMethods($)
{
}
sub documentationHeader($$)
{
my ($file, $descr) = @_;
my $ret = "/***************************************************************************\n";
$ret .= " File: $file - $descr\n";
$ret .= $docTop;
return $ret;
}
sub writeDoc
{
( $lib, $rootnode, $outputdir, $opt ) = @_;
$debug = $main::debuggen;
mkpath( $outputdir ) unless -f $outputdir;
unlink $outputdir."/interfaces_all.i";
# Document all compound nodes
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
}
sub addInterface($$$)
{
my ($outputdir,$typeprefix,$node) = @_;
my $interfacesFile = "interfaces_all.i";
open( IFILE, ">>$outputdir/$interfacesFile" ) || die "Can't open $outputdir/$interfacesFile";
print IFILE "%include \"$typeprefix", kdocAstUtil::heritage($node),".i\"\n";
close IFILE;
}
sub writeClassDoc
{
my( $node ) = @_;
if( exists $node->{ExtSource} ) {
print "Trying to write doc for ".$node->{AstNodeName}.
" from ".$node->{ExtSource}."\n";
return;
}
if( $node->{Access} eq "private" ||
$node->{Access} eq "protected" ) {
return;
}
my $typeName = $node->{astNodeName}."*";
if ( kalyptusDataDict::ctypemap($typeName) eq "" ) {
$typeprefix = ($typeName =~ /^Q/ ? "qt_" : "tde_");
kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
print "'$typeName' => '$typeprefix$typeName',\n";
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
$typeprefix = "qt_";
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^tde_/ ) {
$typeprefix = "tde_";
} else {
$typeprefix = "tde_";
}
my $basefile = "$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
my $cppfile = $basefile;
$cppfile =~ s/\.i/_wrap\.cpp/;
my $file = "$outputdir/$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
my $docnode = $node->{DocNode};
my @list = ();
my $version = undef;
my $author = undef;
addInterface( $outputdir, $typeprefix, $node );
# if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private" || exists $node->{Tmpl} ) {
if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") {
return;
}
open( SWIG_HEADER, ">$file" ) || die "Couldn't create $file\n";
# Header
my $short = "";
my $extra = "";
my $f = $typeprefix . $node->{astNodeName} . ".h";
my $descr = documentationHeader( $f, "header" );
print SWIG_HEADER $descr;
generateHeader( $node, $f );
$f =~ s/\.h$/\.cpp/;
generateSource( $node, $f );
if ( defined $docnode ) {
print SWIG_HEADER "/**\n";
if ( defined $docnode->{Text} ) {
my $node;
foreach $node ( @{$docnode->{Text}} ) {
next if $node->{NodeType} ne "DocText";
print SWIG_HEADER $node->{astNodeName}, "\n";
}
}
exists $docnode->{Author} && print SWIG_HEADER " \@author ", $docnode->{Author}, "\n";
exists $docnode->{Version} && print SWIG_HEADER " \@version ", $docnode->{Version}, "\n";
exists $docnode->{ClassShort} && print SWIG_HEADER " \@short ", $docnode->{ClassShort}, "\n";
print SWIG_HEADER "*/\n";
}
my $sourcename = $node->{Source}->{astNodeName};
if ( $sourcename =~ m!.*(dom|tdeabc|tdeprint|tdesu|tdeio|kjs|tdeparts|tdetexteditor|libtdemid)/([^/]*$)! ) {
$sourcename = $1."/".$2;
} else {
$sourcename =~ s!.*/([^/]*$)!$1!;
}
print SWIG_HEADER "\%module ",$typeprefix,$node->{astNodeName},"\n\n";
print SWIG_HEADER "\%{\n#include <",$sourcename , ">\n\%}\n\n";
#print SWIG_HEADER "\%import \"interfaces_all.i\"\n";
#print SWIG_HEADER "\%import \"", $basefile ,"\"\n";
# make this smarter i guess...
# my @types = neededImportsForObject($node);
# foreach my $f ( @types ) {
# print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
# }
# print SWIG_HEADER "\%import \"qt_Qt.i\"\n";
# my @impor = parentClassNames($node);
# foreach my $f ( @impor ) {
# print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
# }
# Iter::LocalCompounds( $node, sub { my ($node) = @_; print STDERR "$node->{NodeType}||$node->{astNodeName} \n"; } );
# Iter::Generic( $node, undef,
# &isNotProtectedMethod,
# sub { my ($node, $kid) = @_; debugPrint "This is :: ", $node->{astNodeName}, " | ", $kid->{astNodeName}, "\n"; },
# undef );
# Iter::MembersByType ( $node, undef,
# sub { my ($classNode, $methodNode ) = @_;
#
# if ( $methodNode->{NodeType} eq "method" ) {
# print SWIG_HEADER generateMethodsCode( $methodNode, 0 );
# }
# }, undef );
my @parentNames = parentClassNames($node);
my $len = @parentNames;
if ( $len ) {
print SWIG_HEADER "\n";
print SWIG_HEADER "$node->{NodeType} ",$node->{astNodeName}," ";
my $idx = 0;
my $start = 0;
while ( $len-- ) {
if ( $len ) {
if ($parentNames[$idx] ) {
if ( !$start ) {
print SWIG_HEADER ": ";
$start = 1;
}
print SWIG_HEADER " public $parentNames[$idx],\n\t" if $parentNames[$idx];
}
} else {
if ($parentNames[$idx] ) {
if ( !$start ) {
print SWIG_HEADER ": ";
$start = 1;
}
print SWIG_HEADER " public $parentNames[$idx]\n" if $parentNames[$idx];
}
}
++$idx;
}
} else {
print SWIG_HEADER "$node->{NodeType} $node->{astNodeName} ";
}
print SWIG_HEADER "{\n";
# my $name = $node->{astNodeName}."Bridge";
# print SWIG_HEADER normalMethodDeclarations( $node, $name, 1 );
print SWIG_HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
print SWIG_HEADER "};\n\n\n";
# generateNeededTemplatesForObject( $node );
print SWIG_HEADER "\n";
#print SWIG_HEADER "\%inline \%{\n\n";
#print SWIG_HEADER "class ",$node->{astNodeName},";\n";
#print SWIG_HEADER "#include <",$sourcename , ">\n";
#print SWIG_HEADER $node->{astNodeName}, " *",$node->{astNodeName},"Null()\n";
#print SWIG_HEADER "{\n";
#print SWIG_HEADER "\treturn ($node->{astNodeName}*)0L;\n";
#print SWIG_HEADER "}\n\n";
#print SWIG_HEADER "\%}\n";
$constructorCount = 0;
# Iter::MembersByType ( $node,
# sub { print SWIG_HEADER "", $_[0], ""; },
# sub { my ($node, $kid ) = @_;
# preParseMember( $node, $kid );
# },
# sub { print SWIG_HEADER ""; }
# );
# if ( ! exists $node->{Pure} && $constructorCount > 0 ) {
# print SWIG_HEADER "CLASS HEADER = class ", $node->{astNodeName}, "Bridge : public ", kalyptusDataDict::addNamespace($node->{astNodeName}), "\n{\npublic:\n";
# Iter::MembersByType ( $node,
# sub { print SWIG_HEADER "", $_[0], ""; },
# sub { my ($node, $kid ) = @_;
# generateBridgeClass( $node, $kid );
# },
# sub { print SWIG_HEADER ""; }
# );
# generateBridgeEventHandlers($node);
# }
%functionId = ();
$eventHandlerCount = 0;
# Iter::MembersByType ( $node,
# sub { print SWIG_HEADER "", $_[0], ""; },
# sub { my ($node, $kid ) = @_;
# listMember( $node, $kid );
# },
# sub { print SWIG_HEADER ""; }
# );
# ancestors
# my @ancestors = ();
# Iter::Ancestors( $node, $rootnode, undef, undef,
# sub { # print
# my ( $ances, $name, $type, $template ) = @_;
#
# push @ancestors, $name;
#
# },
# undef
# );
# if ( $#ancestors > 0 ) {
# # 'type transfer' functions to cast for correct use of multiple inheritance
# foreach my $ancestor (@ancestors) {
# print SWIG_HEADER "\n/\*\* Casts a '$typeprefix", $node->{astNodeName}, " *' to a '", kalyptusDataDict::ctypemap($ancestor."\*"), "' \*/\n";
# print SWIG_HEADER kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
# print SWIG_HEADER "(", $typeprefix, $node->{astNodeName}, "* instPointer);\n";
# print CLASS kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
# print CLASS "(", $typeprefix, $node->{astNodeName}, "* instPointer){\n";
# print CLASS "\treturn (", kalyptusDataDict::ctypemap($ancestor."\*"), ") (", $ancestor, " *) (", $node->{astNodeName}, " *) instPointer;\n}\n";
# }
# }
close SWIG_HEADER;
}
###################################################################################
1;