#*************************************************************************** # copyright : (C) 2000-2001 Lost Highway Ltd. All Rights Reserved. # (C) 2002 Adam Treat. All Rights Reserved. # email : manyoso@yahoo.com # author : Adam Treat & Richard Dale. #***************************************************************************/ #/*************************************************************************** # * * # * This program is free software; you can redistribute it and/or modify * # * it under the terms of the GNU General Public License as published by * # * the Free Software Foundation; either version 2 of the License, or * # * (at your option) any later version. * # * * #***************************************************************************/ package kalyptusCxxToCSharp; 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 $lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount $pastaccess $pastname $pastreturn $pastparams $nullctor $constructorCount *CLASS *HEADER *TQTCTYPES *KDETYPES /; BEGIN { @clist = (); # Page footer $who = kdocUtil::userName(); $host = kdocUtil::hostName(); $now = localtime; $gentext = "$who using kalyptus $main::Version."; $docTop =<{astNodeName}\n" if $debug; if( exists $node->{ExtSource} ) { warn "Trying to write doc for ".$node->{AstNodeName}. " from ".$node->{ExtSource}."\n"; 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 $file = "$outputdir/".join("__", kdocAstUtil::heritage($node)).".cs"; my $docnode = $node->{DocNode}; my @list = (); my $version = undef; my $author = undef; if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") { return; } open( CLASS, ">$file" ) || die "Couldn't create $file\n"; $file =~ s/\.h/.cpp/; my $short = ""; my $extra = ""; print CLASS "// ", $node->{astNodeName}, ".cs - ", $node->{astNodeName}, " c-sharp implementation."; print CLASS $docTop; print CLASS "\nnamespace Qt {"; print CLASS "\n\n\tusing Qt;"; print CLASS "\n\tusing System;"; print CLASS "\n\tusing System.Runtime.InteropServices;"; # ancestors my @ancestors = (); Iter::Ancestors( $node, $rootnode, undef, undef, sub { # print my ( $ances, $name, $type, $template ) = @_; push @ancestors, $name; }, undef ); if ( $#ancestors < 0 ) { print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : QtSupport {"; if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) { $file = "$outputdir/".join("__", kdocAstUtil::heritage($node)).".cs"; my $interfaceName = kalyptusDataDict::interfacemap($node->{astNodeName}); $file =~ s/$node->{astNodeName}/$interfaceName/; open( INTERFACE, ">$file" ) || die "Couldn't create $file\n"; print INTERFACE "// ", kalyptusDataDict::interfacemap($node->{astNodeName}), ".cs - ", kalyptusDataDict::interfacemap($node->{astNodeName}), " c-sharp implementation."; print INTERFACE $docTop; print INTERFACE "\nnamespace Qt {"; print INTERFACE "\n\n\tusing Qt;"; print INTERFACE "\n\n\tpublic interface ", kalyptusDataDict::interfacemap($node->{astNodeName}), " {"; } } else { my $ancestor; foreach $ancestor ( @ancestors ) { if ( kalyptusDataDict::interfacemap($ancestor) eq () ) { if ( $ancestor eq ("Qt") ){ print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : TQNameSpace "; } else { print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : $ancestor"; } last; } elsif ($ancestor eq @ancestors[$#ancestors] ) { if ( $ancestor eq ("Qt") ){ print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : TQNameSpace "; } else { print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : "; } print CLASS @ancestors[$#ancestors], ""; } } if ( $#ancestors >= 1 ) { foreach $ancestor ( @ancestors ) { if ( kalyptusDataDict::interfacemap($ancestor) ne () ) { print CLASS ", ".kalyptusDataDict::interfacemap($ancestor); } } } if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) { print CLASS ",".kalyptusDataDict::interfacemap($node->{astNodeName}); } print CLASS " {"; } Iter::MembersByType ( $node, sub { print CLASS "", $_[0], ""; print JNISOURCE "", $_[0], ""; }, sub { my ($node, $kid ) = @_; generateClassMethodForEnum( $node, $kid ); }, sub { print CLASS ""; print JNISOURCE ""; } ); %functionId = (); $eventHandlerCount = 0; Iter::MembersByType ( $node, sub { print CLASS "", $_[0], ""; print CLASS "", $_[0], ""; }, sub { my ($node, $kid ) = @_; listMember( $node, $kid ); }, sub { print CLASS ""; print CLASS ""; } ); if ($nullctor ne (1) ) { if ( $#ancestors >= 0 ) { print CLASS "\n\n\t\tpublic ", $node->{astNodeName}, "() : base() {"; print CLASS "\n\n\t\t\t// Dummy constructor for inherited classes."; print CLASS "\n\t\t}"; #print CLASS "\n\n\t\t// This is a convenience constructor for instantiating by passing a RawObject."; #print CLASS "\n\t\tpublic ", $node->{astNodeName}, "(IntPtr raw) : base((Class) null) {"; #print CLASS "\n\n\t\t\tRawObject = raw;"; #print CLASS "\n\t\t}"; } else { print CLASS "\n\n\t\tpublic ", $node->{astNodeName}, "() : base() {"; print CLASS "\n\n\t\t\t// Dummy constructor for inherited classes."; print CLASS "\n\t\t}"; #print CLASS "\n\n\t\t// This is a convenience constructor for instantiating by passing a RawObject."; #print CLASS "\n\t\tpublic ", $node->{astNodeName}, "(IntPtr raw) {"; #print CLASS "\n\n\t\t\tRawObject = raw;"; #print CLASS "\n\t\t}"; } } print CLASS "\n\t}\n}\n"; close CLASS; $nullctor = 0; if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) { print INTERFACE "\n\t}\n}\n"; close INTERFACE; } } sub listMember { my( $class, $m, $ancestorCount) = @_; my $name; my $function; my $csharpaccess; my $csharpparams; my $returnType; $name = $m->{astNodeName} ; my $type = $m->{NodeType}; my $docnode = $m->{DocNode}; if ( $m->{ReturnType} =~ /~/ ) { $name = "~".$name; } if ( $functionId{$name} eq "" ) { $functionId{$name} = 0; $function = $name; } else { $functionId{$name}++; $function = $name.$functionId{$name}; } $function =~ s/~//; if( $type eq "method" && $m->{Access} ne "private" && $m->{Access} ne "private_slots" && $m->{Access} ne "signals" ) { if ( $m->{ReturnType} =~ /[<>]/ || $m->{Params} =~ /[<>]/ || $m->{Params} =~ /\.\.\./ || $m->{Params} =~ /Impl/ || $m->{ReturnType} =~ /TQAuBucket/ || $m->{Params} =~ /TQAuBucket/ || $m->{ReturnType} =~ /TQMember/ || $m->{Params} =~ /TQMember/ ) { return; } $returnType = $m->{ReturnType}; $returnType =~ s/const\s*//; $returnType =~ s/inline\s*//; $returnType =~ s/\s*([,\*\&])\s*/$1/; $returnType =~ s/^\s*//; $returnType =~ s/\s*$//; if ( $returnType ne "" && cplusplusToPInvoke($returnType) eq () ) { $returnType =~ s/^.*::.*$/int/; } else { $returnType = cplusplusToPInvoke($returnType); } if ( $returnType eq "RawObject") { $returnType = "IntPtr"; } my $cparams = $m->{Params}; my $cplusplusparams; my $pinvokeparams; my $pinvokeargs; # TODO port to $m->{ParamList} $cparams =~ s/\s+/ /g; $cparams =~ s/\s*([,\*\&])\s*/$1 /g; $cparams =~ s/^\s*void\s*$//; my $argId = 0; my @cargs = kdocUtil::splitUnnested(",", $cparams); $cparams = ""; foreach my $arg ( @cargs ) { my $argType; my $cargType; my $csharpargType; my $pinvokeargType; if ( $arg =~ /^\s*$/ ) { next; } # A ' = ' default parameter $arg =~ s/\s*([^\s].*[^\s])\s*/$1/; $arg =~ s/(\w+)\[\]/\* $1/; $arg =~ s/=\s*(("[^\"]*")|(\'.\')|(([-\w:.]*)\s*(\|\s*[-\w]*)*(\(\w*\))?))//; if ( $arg =~ /^(.*)\s+(\w+)\s*$/ ) { $argType = $1; $arg = $2; } else { $argType = $arg; $argId++; $arg = "arg".$argId; } $arg =~ s/^id$/identifier/; $argType =~ s/\s*([^\s].*[^\s])\s*/$1/; $argType =~ s/\s*const//g; $argType =~ s/^\s*//; $argType =~ s/([\*\&])\s*([\*\&])/$1$2/; $cargType = kalyptusDataDict::ctypemap($argType); $csharpargType = cplusplusToCSharp($argType); $pinvokeargType = cplusplusToPInvoke($argType); if ( $csharpargType eq "" ) { $csharpargType = $argType; $csharpargType =~ s/\&/\*/; $csharpargType =~ s/^.*::.*$/int/; } if ( $pinvokeargType eq "" ) { $pinvokeargType = $argType; $pinvokeargType =~ s/\&/\*/; $pinvokeargType =~ s/^.*::.*$/int/; } $arg = checkReserved($arg); if ( $pinvokeargType =~ /IntPtr/ ) { $pinvokeargs .= "$arg.Ptr, "; } elsif ( $csharpargType =~ /\./ ) { $pinvokeargs .= "($pinvokeargType)$arg, "; } else { $pinvokeargs .= "$arg, "; } if ( $pinvokeargType =~ /RawObject/ ) { $pinvokeargType =~ s/RawObject/IntPtr/; } $csharpparams .= "$csharpargType $arg, "; $pinvokeparams .= "$pinvokeargType $arg, "; } $cparams =~ s/, $//; $cplusplusparams =~ s/, $//; $csharpparams =~ s/, $//; $pinvokeparams =~ s/, $//; $pinvokeargs =~ s/, $//; my $flags = $m->{Flags}; if ( !defined $flags ) { warn "Method ".$m->{astNodeName}. " has no flags\n"; } my $extra = ""; $extra .= "static " if $flags =~ "s"; if ( $name =~ /operator/ ) { return; } if ( $m->{Access} =~ /protected/ && $name ne $class->{astNodeName} ) { if ( $class->{Pure} ) { return; } $name = "protected_".$name; } $m->{Access} =~ /([^_]*)(.*)?\s*/; $csharpaccess = $1; if ( $extra =~ /static/ ) { $csharpaccess .= " static"; } if ( $name eq $class->{astNodeName} && $class->{Pure} ) { return; } if ( defined $docnode ) { if ( defined $docnode->{Text} ) { print CLASS "\n/** "; my $node; my $line; foreach $node ( @{$docnode->{Text}} ) { next if $node->{NodeType} ne "DocText"; $line = $node->{astNodeName}; print CLASS $line, "\n"; } print CLASS "*/\n"; } } #This is to make sure we have no duplicate methods... my $currentmethod .= "$name $returnType $csharpparams"; my $pastmethod .= "$pastname $pastreturn $pastparams"; if($currentmethod ne $pastmethod) { if ( $name eq $class->{astNodeName} ) { #All the constructors are generated here except the dummy constructor #print CLASS "\n// DLLImport goes here..."; print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]"; print CLASS "\n\t\tprivate static extern IntPtr ", $typeprefix, "new_", $function, "(", $pinvokeparams, ");"; print CLASS "\n\t\t", $csharpaccess, " ", $class->{astNodeName}, "(", $csharpparams, ") "; if ($ancestorCount >= 0) { print CLASS ": base() {"; } else { print CLASS "{"; } print CLASS "\n\n\t\t\tRawObject = ", $typeprefix, "new_", $function, "(", $pinvokeargs, ");"; print CLASS "\n\t\t}"; if ($csharpparams eq () ) { $nullctor = 1; } } elsif ( $returnType =~ /~/ ) { #The deconstructor is here print CLASS "\n\n\t\t// Deconstructor goes here..."; print CLASS "\n\t\t", $csharpaccess, " void ", "del_", $function, "( ", $class->{astNodeName}, " p ){}"; } else { if ( $name =~ /.*Event$/ ) { return; } # Class or instance method my $selfstring; if ( $extra =~ /static/ ) { if ( exists $class->{Pure} || $constructorCount == 0 ) { $selfstring = kalyptusDataDict::addNamespace($class->{astNodeName})."::"; } else { $selfstring = $class->{astNodeName}."Bridge::"; } #Static Methods are generated here #print CLASS "\n\n\t\t// DLLImport method goes here..."; print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]"; print CLASS "\n\t\tprivate static extern", " ", $returnType, " ", $typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeparams, ");"; print CLASS "\n\t\t", $csharpaccess, " ", $returnType, " ", $name, "(", $csharpparams, ") {"; if ($returnType =~ /void/ ) { print CLASS "\n\n\t\t\t",$typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeargs, ");"; } else { print CLASS "\n\n\t\t\treturn ", $typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeargs, ");"; } print CLASS "\n\t\t}"; } else { if ( exists $class->{Pure} || $constructorCount == 0 ) { $selfstring = "((".kalyptusDataDict::addNamespace($class->{astNodeName})."*)instPointer)->"; } else { $selfstring = "((".$class->{astNodeName}."Bridge*)instPointer)->"; } #Methods are generated here #print CLASS "\n\n\t\t// DLLImport method goes here..."; print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]"; print CLASS "\n\t\tprivate static extern", " ", $returnType, " ", $typeprefix, $class->{astNodeName}, "_", $function, "(", "IntPtr raw", ($pinvokeparams eq "" ? "" : ", "), $pinvokeparams, ");"; print CLASS "\n\t\t", $csharpaccess, " ", $returnType, " ", checkReserved($name), "(", $csharpparams, ") {"; if ($returnType =~ /void/ ) { print CLASS "\n\n\t\t\t",$typeprefix, $class->{astNodeName}, "_", $function, "(", "RawObject", ($pinvokeargs eq "" ? "" : ", "), $pinvokeargs, ");"; } else { print CLASS "\n\n\t\t\treturn ", $typeprefix, $class->{astNodeName}, "_", $function, "(", "RawObject", ($pinvokeargs eq "" ? "" : ", "), $pinvokeargs, ");"; } print CLASS "\n\t\t}"; } } } } #Part of the duplicate methods check. $pastname = $name; $pastreturn = $returnType; $pastparams = $csharpparams; $csharpparams = ""; } sub generateClassMethodForEnum { my( $class, $m ) = @_; my $enum = $m->{astNodeName}; my $csharpaccess; $m->{Access} =~ /([^_]*)(.*)?\s*/; $csharpaccess = $1; if( $m->{NodeType} eq "enum" ) { my $enum = $m->{astNodeName}; my @enums = split(",", $m->{Params}); my $enumCount = 0; if($enum ne " ") { print CLASS "\n\n\t\t$csharpaccess enum", $enum,":long {"; foreach my $enum ( @enums ) { $enum =~ s/\s//g; $enum =~ s/::/./g; if($#enums == $enumCount){ if ( $enum =~ /(.*)=(.*)/ ) { print CLASS "\n\t\t\t$1 = $2"; } else { print CLASS "\n\t\t\t$enum = $enumCount"; } } else { if ( $enum =~ /(.*)=(.*)/ ) { print CLASS "\n\t\t\t$1 = $2,"; } else { print CLASS "\n\t\t\t$enum = $enumCount,"; } } $enumCount++; } print CLASS "\n\t\t}"; } } } 1;