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.
765 lines
24 KiB
765 lines
24 KiB
13 years ago
|
#***************************************************************************
|
||
|
|
# 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 =<<EOF
|
||
|
|
|
||
|
|
// begin : $now
|
||
|
|
// copyright : (C) 2002 Adam Treat. All rights reserved.
|
||
|
|
// email : manyoso\@yahoo.com
|
||
|
|
// generated by : $gentext
|
||
|
|
|
||
|
|
// 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.
|
||
|
|
|
||
|
|
EOF
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cplusplusToCSharp
|
||
|
|
{
|
||
|
|
my ( $cplusplusType ) = @_;
|
||
|
|
if ( $cplusplusType =~ /bool/ && kalyptusDataDict::ctypemap($cplusplusType) eq "int" ) {
|
||
|
|
return "bool";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*void\s*\**/ ) {
|
||
|
|
return "int";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\&*/ ) {
|
||
|
|
return "int";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\*/) {
|
||
|
|
return "int[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*double\s*\*/ ) {
|
||
|
|
return "double[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*short\s*\*/ ) {
|
||
|
|
return "short[]";
|
||
|
|
} elsif ( $cplusplusType =~ /TQByteArray/ || $cplusplusType =~ /TQBitArray/ ) {
|
||
|
|
return "byte[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\*\*/ ) {
|
||
|
|
return "string[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\**/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned int\s*\**/ ) {
|
||
|
|
return "uint";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned short\s*\**/ ) {
|
||
|
|
return "ushort";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned long\s*\**/ ) {
|
||
|
|
return "ulong";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned char\s*\**/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( $cplusplusType =~ /^GUID/ ) {
|
||
|
|
return "System.Guid";
|
||
|
|
} elsif ( $cplusplusType =~ /^FILE/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( $cplusplusType =~ /^_NPStream/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQPtrCollection/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQStyleHintReturn/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^type/i ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^Key/ || $cplusplusType =~ /^key_type/ || $cplusplusType =~ /^K/) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQUnknownInterface/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^GDHandle/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQTextParag/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQDiskFont/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQDomNodePrivate/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^Display/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQUuid/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^Q_REFCOUNT/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^EventRef/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^MSG/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQWSEvent/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^XEvent/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^CGContextRef/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQWSDecoration/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQTextFormat/ || $cplusplusType =~ /^TQTextDocument/ || $cplusplusType =~ /^TQTextCursor/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQSqlRecordPrivate/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^Text/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^Event/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /^NavDirection/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif (
|
||
|
|
$cplusplusType =~ /^pointer$/
|
||
|
|
|| $cplusplusType =~/T\*$/
|
||
|
|
|| $cplusplusType =~/T\&*$/
|
||
|
|
|| $cplusplusType =~/T1\&*$/
|
||
|
|
|| $cplusplusType =~/T2\&*$/
|
||
|
|
|| $cplusplusType =~/^Iterator/i
|
||
|
|
|| $cplusplusType =~/^_iterator/i
|
||
|
|
|| $cplusplusType =~/^reference/
|
||
|
|
|| $cplusplusType =~/^_reference/) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ($cplusplusType =~ /::/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /::/ ||
|
||
|
|
$cplusplusType =~ /&$/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /&$/ ||
|
||
|
|
$cplusplusType =~ /\*/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /\*/) {
|
||
|
|
|
||
|
|
$cplusplusType =~ s/::/./g;
|
||
|
|
$cplusplusType =~ s/&//g;
|
||
|
|
$cplusplusType =~ s/\*//g;
|
||
|
|
return $cplusplusType;
|
||
|
|
|
||
|
|
} else {
|
||
|
|
return kalyptusDataDict::ctypemap($cplusplusType);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cplusplusToPInvoke
|
||
|
|
{
|
||
|
|
my ( $cplusplusType ) = @_;
|
||
|
|
if ( $cplusplusType =~ /bool/ && kalyptusDataDict::ctypemap($cplusplusType) eq "int" ) {
|
||
|
|
return "bool";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*void\s*\*/ ) {
|
||
|
|
return "int";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\&*/ ) {
|
||
|
|
return "int";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\*/) {
|
||
|
|
return "int[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*double\s*\*/ ) {
|
||
|
|
return "double[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*short\s*\*/ ) {
|
||
|
|
return "short[]";
|
||
|
|
} elsif ( $cplusplusType =~ /TQByteArray/ || $cplusplusType =~ /TQBitArray/ ) {
|
||
|
|
return "byte[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\*\*/ ) {
|
||
|
|
return "string[]";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\**/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned int\s*\**/ ) {
|
||
|
|
return "uint";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned short\s*\**&*/ ) {
|
||
|
|
return "ushort";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned long\s*\**/ ) {
|
||
|
|
return "ulong";
|
||
|
|
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned char\s*\**/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( $cplusplusType =~ /^GUID/ ) {
|
||
|
|
return "System.Guid";
|
||
|
|
} elsif ( $cplusplusType =~ /^FILE/ ) {
|
||
|
|
return "string";
|
||
|
|
} elsif ( $cplusplusType =~ /^_NPStream/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQPtrCollection/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQStyleHintReturn/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^type/i ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^Key/ || $cplusplusType =~ /^key_type/ || $cplusplusType =~ /^K/) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQUnknownInterface/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^GDHandle/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQTextParag/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQDiskFont/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQDomNodePrivate/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^Display/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQUuid/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^Q_REFCOUNT/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^EventRef/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^MSG/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQWSEvent/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^XEvent/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^CGContextRef/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQWSDecoration/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQTextFormat/ || $cplusplusType =~ /^TQTextDocument/ || $cplusplusType =~ /^TQTextCursor/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^TQSqlRecordPrivate/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^Text/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^Event/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /^NavDirection/ ) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif (
|
||
|
|
$cplusplusType =~ /^pointer$/
|
||
|
|
|| $cplusplusType =~/T\*$/
|
||
|
|
|| $cplusplusType =~/T\&*$/
|
||
|
|
|| $cplusplusType =~/T1\&*$/
|
||
|
|
|| $cplusplusType =~/T2\&*$/
|
||
|
|
|| $cplusplusType =~/^iterator/i
|
||
|
|
|| $cplusplusType =~/^_iterator/i
|
||
|
|
|| $cplusplusType =~/^reference/
|
||
|
|
|| $cplusplusType =~/^_reference/) {
|
||
|
|
return "RawObject";
|
||
|
|
} elsif ( $cplusplusType =~ /&$/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /&$/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} elsif ( $cplusplusType =~ /\*/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /\*/ ) {
|
||
|
|
return "IntPtr";
|
||
|
|
} else {
|
||
|
|
return kalyptusDataDict::ctypemap($cplusplusType);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub checkReserved
|
||
|
|
{
|
||
|
|
my ( $name ) = @_;
|
||
|
|
|
||
|
|
if ( $name =~ /^lock$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^object$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^ref$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^base$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^string$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^const$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^event$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} elsif ( $name =~ /^internal$/i ) {
|
||
|
|
return "res_$name";
|
||
|
|
} else {
|
||
|
|
return $name;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub writeDoc
|
||
|
|
{
|
||
|
|
( $lib, $rootnode, $outputdir, $opt ) = @_;
|
||
|
|
|
||
|
|
$debug = $main::debuggen;
|
||
|
|
|
||
|
|
mkpath( $outputdir ) unless -f $outputdir;
|
||
|
|
|
||
|
|
|
||
|
|
# Document all compound nodes
|
||
|
|
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub writeClassDoc
|
||
|
|
{
|
||
|
|
my( $node ) = @_;
|
||
|
|
|
||
|
|
print "Enter: $node->{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 '<arg> = <value>' 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;
|
||
|
|
|