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.
997 lines
27 KiB
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&',
|
|
'Q_INT16' => 'short',
|
|
'Q_INT32' => 'int',
|
|
'Q_INT8' => 'char',
|
|
'Q_LONG' => 'long',
|
|
'Q_UINT16' => 'ushort',
|
|
'Q_UINT32' => 'uint',
|
|
'Q_UINT8' => 'uchar',
|
|
'Q_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_" : "kde_");
|
|
kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
|
|
print "'$typeName' => '$typeprefix$typeName',\n";
|
|
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
|
|
$typeprefix = "qt_";
|
|
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/ ) {
|
|
$typeprefix = "kde_";
|
|
} else {
|
|
$typeprefix = "kde_";
|
|
}
|
|
|
|
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|kabc|tdeprint|tdesu|kio|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;
|
|
|