summaryrefslogtreecommitdiffstats
path: root/kalyptus/kalyptusCxxToSwig.pm
diff options
context:
space:
mode:
Diffstat (limited to 'kalyptus/kalyptusCxxToSwig.pm')
-rw-r--r--kalyptus/kalyptusCxxToSwig.pm996
1 files changed, 996 insertions, 0 deletions
diff --git a/kalyptus/kalyptusCxxToSwig.pm b/kalyptus/kalyptusCxxToSwig.pm
new file mode 100644
index 0000000..f25387e
--- /dev/null
+++ b/kalyptus/kalyptusCxxToSwig.pm
@@ -0,0 +1,996 @@
+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|kparts|ktexteditor|libkmid)/([^/]*$)! ) {
+ $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;
+
generated by cgit v1.2.1 (git 2.18.0) at 2024-12-23 07:56:38 +0000