mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 13:38:31 +02:00
- remove unused and non functional kalyptus port
git-svn-id: trunk@16852 -
This commit is contained in:
florian
parent
1fef7e4b6c
commit
f5bde338ff
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -12103,9 +12103,6 @@ utils/h2pas/scan.pas svneol=native#text/plain
|
||||
utils/h2pas/testit.h -text
|
||||
utils/h2pas/yylex.cod -text
|
||||
utils/h2pas/yyparse.cod -text
|
||||
utils/kalyptus/kalyptus -text
|
||||
utils/kalyptus/kalyptusCxxToPas.pm -text
|
||||
utils/kalyptus/kalyptusDataDict.pm -text
|
||||
utils/mksymbian/Makefile svneol=native#text/plain
|
||||
utils/mksymbian/Makefile.fpc svneol=native#text/plain
|
||||
utils/mksymbian/cfgfile.pas svneol=native#text/plain
|
||||
|
||||
8
.gitignore
vendored
8
.gitignore
vendored
@ -7744,14 +7744,6 @@ utils/h2pas/*.s
|
||||
utils/h2pas/Package.fpc
|
||||
utils/h2pas/fpcmade.*
|
||||
utils/h2pas/units
|
||||
utils/kalyptus/*.bak
|
||||
utils/kalyptus/*.exe
|
||||
utils/kalyptus/*.o
|
||||
utils/kalyptus/*.ppu
|
||||
utils/kalyptus/*.s
|
||||
utils/kalyptus/Package.fpc
|
||||
utils/kalyptus/fpcmade.*
|
||||
utils/kalyptus/units
|
||||
utils/mksymbian/*.bak
|
||||
utils/mksymbian/*.exe
|
||||
utils/mksymbian/*.o
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,893 +0,0 @@
|
||||
package kalyptusCxxToPas;
|
||||
|
||||
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 @functions
|
||||
$lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount $constructorCount *CLASS *HEADER *QTCTYPES *KDETYPES /;
|
||||
|
||||
my @qtcfunctions;
|
||||
my %inheritance;
|
||||
my @typeenums;
|
||||
|
||||
my %pasopmap = (
|
||||
'<<' => ' shl ',
|
||||
'>>' => ' shr ',
|
||||
'|' => ' or ',
|
||||
'&' => ' and '
|
||||
);
|
||||
|
||||
BEGIN
|
||||
{
|
||||
@clist = ();
|
||||
|
||||
# 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) 2000-2001 Lost Highway Ltd. All rights reserved.
|
||||
email : Lost_Highway\@tipitina.demon.co.uk
|
||||
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
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub writeDoc
|
||||
{
|
||||
( $lib, $rootnode, $outputdir, $opt ) = @_;
|
||||
|
||||
$debug = $main::debuggen;
|
||||
|
||||
mkpath( $outputdir ) unless -f $outputdir;
|
||||
|
||||
my $file = "$outputdir/qt.pp";
|
||||
open( QTCTYPES, ">$file" ) || die "Couldn't create $file\n";
|
||||
print QTCTYPES "{***************************************************************************\n";
|
||||
print QTCTYPES $docTop,"}\n\n";
|
||||
print QTCTYPES "unit qt;\n\n";
|
||||
print QTCTYPES " interface\n\n";
|
||||
print QTCTYPES " {\$i qt_extra.inc}\n\n";
|
||||
print QTCTYPES "// typedef void (*qt_UserDataCallback)(void *, void *);\n";
|
||||
print QTCTYPES "// typedef int (*qt_eventFilter)(qt_QObject*,qt_QEvent*);\n";
|
||||
print QTCTYPES "// typedef int (*qt_EventDelegate)(void *, char *, void *, char *);\n";
|
||||
print QTCTYPES "// extern qt_EventDelegate Qt_EventDelegate;\n";
|
||||
|
||||
$file = "$outputdir/kde.pp";
|
||||
open( KDETYPES, ">$file" ) || die "Couldn't create $file\n";
|
||||
print KDETYPES "{***************************************************************************\n";
|
||||
print KDETYPES " kde_types.pas - description\n";
|
||||
print KDETYPES $docTop,"}\n\n";
|
||||
print KDETYPES "unit kde;\n\n";
|
||||
print KDETYPES " interface\n\n";
|
||||
print KDETYPES " type\n";
|
||||
|
||||
# Document all compound nodes
|
||||
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
|
||||
|
||||
# write all classes sorted by inheritance
|
||||
|
||||
# my @inheritance_sorted = sort {
|
||||
# if ($inheritance{$a} eq "") {
|
||||
# if ($inheritance{$b} eq "") {
|
||||
# return 0;
|
||||
# } else {
|
||||
# return -1;
|
||||
# }
|
||||
# } else {
|
||||
# if ($inheritance{$b} eq "") {
|
||||
# return 1;
|
||||
# }
|
||||
# }
|
||||
# my $parent=$inheritance{$a};
|
||||
# while ($parent ne "") {
|
||||
# if ($parent eq $b) {
|
||||
# return 1;
|
||||
# }
|
||||
# $parent=$inheritance{$parent};
|
||||
# }
|
||||
# $parent=$inheritance{$b};
|
||||
# while ($parent ne "") {
|
||||
# if ($parent eq $a) {
|
||||
# return -1;
|
||||
# }
|
||||
# $parent=$inheritance{$parent};
|
||||
# }
|
||||
# return 0;
|
||||
# } keys %inheritance;
|
||||
|
||||
# for my $key (@inheritance_sorted) {
|
||||
print "Start writing classes\n";
|
||||
while (keys %inheritance>0) {
|
||||
my $key;
|
||||
my $value;
|
||||
while ( ($key, $value) = each %inheritance) {
|
||||
if (!(exists $inheritance{$value}) || ($value eq "")) {
|
||||
if ($value eq "") {
|
||||
print QTCTYPES " ",$key,"H = class end;\n";
|
||||
} else {
|
||||
print QTCTYPES " ",$key,"H = class(",$value,"H) end;\n";
|
||||
}
|
||||
delete $inheritance{$key};
|
||||
}
|
||||
}
|
||||
}
|
||||
print "Finished writing classes\n";
|
||||
print QTCTYPES "\n";
|
||||
|
||||
# write enums
|
||||
for my $enum (@typeenums)
|
||||
{
|
||||
print QTCTYPES $enum;
|
||||
}
|
||||
print QTCTYPES "\n";
|
||||
|
||||
for my $func (@qtcfunctions)
|
||||
{
|
||||
print QTCTYPES $func,"\n";
|
||||
}
|
||||
print QTCTYPES "\nimplementation\nend.\n";
|
||||
|
||||
print KDETYPES "\nimplementation\n\nend.\n";
|
||||
|
||||
close QTCTYPES;
|
||||
close KDETYPES;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
=head2 writeClassDoc
|
||||
|
||||
Write documentation for one compound node.
|
||||
|
||||
=cut
|
||||
|
||||
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::pastypemap($typeName) eq "" ) {
|
||||
$typeprefix = ($typeName =~ /^Q/ ? "qt_" : "kde_");
|
||||
kalyptusDataDict::setpastypemap($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 = "";
|
||||
}
|
||||
|
||||
my $file = "$outputdir/".join("__", kdocAstUtil::heritage($node))."h.inc";
|
||||
my $docnode = $node->{DocNode};
|
||||
my @list = ();
|
||||
my $version = undef;
|
||||
my $author = undef;
|
||||
|
||||
# if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private" || exists $node->{Tmpl} ) {
|
||||
if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") {
|
||||
return;
|
||||
}
|
||||
|
||||
open( HEADER, ">".lc("$file") ) || die "Couldn't create $file\n";
|
||||
$file =~ s/\h.inc/.cpp/;
|
||||
open( CLASS, ">".lc("$file") ) || die "Couldn't create $file\n";
|
||||
|
||||
# Header
|
||||
|
||||
my $short = "";
|
||||
my $extra = "";
|
||||
|
||||
# ancestors
|
||||
my @ancestors = ();
|
||||
my $parent = "";
|
||||
|
||||
Iter::Ancestors( $node, $rootnode, undef, undef,
|
||||
sub { # print
|
||||
my ( $ances, $name, $type, $template ) = @_;
|
||||
push @ancestors, $name;
|
||||
},
|
||||
undef
|
||||
);
|
||||
|
||||
if ($#ancestors >= 0) {
|
||||
|
||||
# nested classes aren't possible in Object Pascal
|
||||
# they are moved to level 1
|
||||
@ancestors[0] =~ s/[^:]*::([^:]*)/$1/;
|
||||
$inheritance{$node->{astNodeName}}=@ancestors[0];
|
||||
} else {
|
||||
$inheritance{$node->{astNodeName}}="";
|
||||
}
|
||||
|
||||
if ( kalyptusDataDict::pastypemap($typeName) =~ /^kde_/ ) {
|
||||
# @qtcfunctions[$#qtcfunctions+1]=" {\$i ".$node->{astNodeName}."h.inc}\n";
|
||||
} else {
|
||||
@qtcfunctions[$#qtcfunctions+1]=" {\$i ".$node->{astNodeName}."h.inc}\n";
|
||||
}
|
||||
|
||||
print HEADER "{***************************************************************************\n";
|
||||
print HEADER " ", $node->{astNodeName},".pas - description\n";
|
||||
print HEADER $docTop,"}\n\n";
|
||||
|
||||
print CLASS "/***************************************************************************\n";
|
||||
print CLASS " ", $typeprefix, $node->{astNodeName}, ".cpp - description\n";
|
||||
print CLASS $docTop,"*/\n\n";
|
||||
print CLASS "extern \"C\" {\n#include \"", $typeprefix, $node->{astNodeName}, ".h\"\n}\n\n";
|
||||
|
||||
my $sourcename = $node->{Source}->{astNodeName};
|
||||
|
||||
if ( $sourcename =~ m!.*(dom|kabc|kdeprint|kdesu|kio|kjs|kparts|ktexteditor|libkmid)/([^/]*$)! ) {
|
||||
$sourcename = $1."/".$2;
|
||||
} else {
|
||||
$sourcename =~ s!.*/([^/]*$)!$1!;
|
||||
}
|
||||
|
||||
print CLASS "#include <",$sourcename , ">\n\n";
|
||||
|
||||
$constructorCount = 0;
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print HEADER "", $_[0], ""; print CLASS "", $_[0], ""; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
preParseMember( $node, $kid );
|
||||
},
|
||||
sub { print HEADER ""; print CLASS ""; }
|
||||
);
|
||||
|
||||
if ( ! exists $node->{Pure} && $constructorCount > 0 ) {
|
||||
print CLASS "class ", $node->{astNodeName}, "Bridge : public ", kalyptusDataDict::addNamespace($node->{astNodeName}), "\n{\npublic:\n";
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print HEADER "", $_[0], ""; print CLASS "", $_[0], ""; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
generateBridgeClass( $node, $kid );
|
||||
},
|
||||
sub { print HEADER ""; print CLASS ""; }
|
||||
);
|
||||
|
||||
generateBridgeEventHandlers($node);
|
||||
|
||||
print CLASS "};\n\n";
|
||||
}
|
||||
|
||||
%functionId = ();
|
||||
$eventHandlerCount = 0;
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print HEADER "", $_[0], ""; print CLASS "", $_[0], ""; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
listMember( $node, $kid );
|
||||
},
|
||||
sub { print HEADER ""; print CLASS ""; }
|
||||
);
|
||||
|
||||
if ( $#ancestors > 0 ) {
|
||||
# 'type transfer' functions to cast for correct use of multiple inheritance
|
||||
foreach my $ancestor (@ancestors) {
|
||||
print HEADER "\n{\*\* Casts a '$typeprefix", $node->{astNodeName}, " *' to a '", kalyptusDataDict::pastypemap($ancestor."\*"), "' \}\n";
|
||||
print HEADER "function ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
|
||||
print HEADER "(", $typeprefix, "instPointer : ",$node->{astNodeName}, "H) : ",kalyptusDataDict::pastypemap($ancestor."\*"),";cdecl;\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";
|
||||
}
|
||||
}
|
||||
|
||||
$file =~ s/\.cpp/.inc/;
|
||||
|
||||
open(BODY, ">".lc("$file") ) || die "Couldn't create $file\n";
|
||||
|
||||
for my $func (@functions)
|
||||
{
|
||||
print BODY $func,"\n";
|
||||
}
|
||||
|
||||
@functions=();
|
||||
|
||||
close BODY;
|
||||
close CLASS;
|
||||
close HEADER;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub preParseMember
|
||||
{
|
||||
my( $class, $m ) = @_;
|
||||
my $name = $m->{astNodeName};
|
||||
|
||||
if( $m->{NodeType} eq "method" ) {
|
||||
# A JBridge class will only be generated if there is at least one
|
||||
# public or protected constructor
|
||||
if ( $name eq $class->{astNodeName} && $m->{Access} ne "private" ) {
|
||||
$constructorCount++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub generateBridgeEventHandlers
|
||||
{
|
||||
my( $node ) = @_;
|
||||
my %allmem = ();
|
||||
my $key;
|
||||
|
||||
my $m;
|
||||
my $name;
|
||||
|
||||
kdocAstUtil::allMembers( \%allmem, $node );
|
||||
|
||||
foreach $key (keys (%allmem)) {
|
||||
$m = $allmem{$key};
|
||||
$name = $m->{astNodeName} ;
|
||||
my $type = $m->{NodeType};
|
||||
my $docnode = $m->{DocNode};
|
||||
my $pasparams = $m->{Params};
|
||||
my $parent = $m->{Parent};
|
||||
my $cplusplusparams;
|
||||
|
||||
if( $type eq "method" && $m->{Access} eq "protected" && $name =~ /.*Event$/
|
||||
&& $name !~ /qwsEvent/ && $name !~ /x11Event/ && $name !~ /winEvent/ && $name !~ /macEvent/ && $name !~ /movableDropEvent/ ) {
|
||||
|
||||
$pasparams =~ s/=\s*[-\"\w]*//g;
|
||||
$pasparams =~ s/\s+/ /g;
|
||||
$pasparams =~ s/\s*([,\*\&])\s*/$1 /g;
|
||||
$pasparams =~ s/^\s*void\s*$//;
|
||||
my $argId = 0;
|
||||
my @cargs = kdocUtil::splitUnnested(",", $pasparams);
|
||||
my $cplusplusargs = "";
|
||||
foreach my $arg ( @cargs ) {
|
||||
my $argType;
|
||||
my $cargType;
|
||||
|
||||
$arg =~ s/\s*([^\s].*[^\s])\s*/$1/;
|
||||
if ( $arg =~ /(.*)\s+(\w+)$/ ) {
|
||||
$argType = $1;
|
||||
$arg = $2;
|
||||
} else {
|
||||
$argType = $arg;
|
||||
$argId++;
|
||||
$arg = "arg".$argId;
|
||||
}
|
||||
$cplusplusparams .= $argType." ".$arg.", ";
|
||||
$cplusplusargs .= $arg.", ";
|
||||
}
|
||||
$pasparams =~ s/; $//;
|
||||
$cplusplusparams =~ s/, $//;
|
||||
$cplusplusargs =~ s/, $//;
|
||||
|
||||
$eventHandlerCount++;
|
||||
my $eventType = $cplusplusparams;
|
||||
$eventType =~ s/(.*)\*.*$/$1/;
|
||||
print CLASS "\tvoid $name(", $cplusplusparams, ") {\n",
|
||||
"\t\tif (Qt_EventDelegate == 0L || !(*Qt_EventDelegate)(this, \"", $name, "\", $cplusplusargs, \"$eventType\")) {\n",
|
||||
"\t\t\t", $parent->{astNodeName}, "::", $name, "($cplusplusargs);\n",
|
||||
"\t\t}\n",
|
||||
"\t\treturn;\n\t}\n";
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub changehex($)
|
||||
{
|
||||
my $value = @_[0];
|
||||
$value =~ s/0x/\$/;
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub generateBridgeClass
|
||||
{
|
||||
my( $class, $m ) = @_;
|
||||
my $name;
|
||||
my $function;
|
||||
|
||||
$name = $m->{astNodeName} ;
|
||||
my $type = $m->{NodeType};
|
||||
my $docnode = $m->{DocNode};
|
||||
|
||||
if( $type eq "method" && $m->{Access} ne "private" && $m->{Access} ne "private_slots" && $m->{Access} ne "signals" ) {
|
||||
if ( $m->{ReturnType} =~ /[<>]/ || $m->{Params} =~ /[<>]/ || $m->{Params} =~ /Impl/) {
|
||||
# print "template based method not converted: ", $m->{ReturnType}, " ", $m->{Params}, "\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my $returnType = $m->{ReturnType};
|
||||
my $pasparams = $m->{Params};
|
||||
my $cplusplusparams;
|
||||
# TODO port to $m->{ParamList}
|
||||
$pasparams =~ s/=\s*(("[^\"]*")|(\'.\')|(([-\w:.]*)\s*(\|\s*[-\w]*)*(\(\w*\))?))//g;
|
||||
$pasparams =~ s/\s+/ /g;
|
||||
$pasparams =~ s/\s*([,\*\&])\s*/$1 /g;
|
||||
$pasparams =~ s/^\s*void\s*$//;
|
||||
$pasparams =~ s/^\s*$//;
|
||||
my $argId = 0;
|
||||
my @cargs = kdocUtil::splitUnnested(",", $pasparams);
|
||||
$pasparams = "";
|
||||
foreach my $arg ( @cargs ) {
|
||||
my $argType;
|
||||
my $cargType;
|
||||
$arg =~ s/\s*([^\s].*[^\s])\s*/$1/;
|
||||
if ( $arg =~ /(.*)\s+(\w+)$/ ) {
|
||||
$argType = $1;
|
||||
$arg = $2;
|
||||
} else {
|
||||
$argType = $arg;
|
||||
$argId++;
|
||||
$arg = "arg".$argId;
|
||||
}
|
||||
$cplusplusparams .= $argType." ".$arg.", ";
|
||||
$pasparams .= $arg.", ";
|
||||
}
|
||||
$pasparams =~ s/, $//;
|
||||
$cplusplusparams =~ 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 ( $name eq $class->{astNodeName} ) {
|
||||
if ( $returnType =~ "~" ) {
|
||||
print CLASS "\t~", $name, "Bridge() {}\n";
|
||||
} else {
|
||||
print CLASS $extra,
|
||||
"\t", $name, "Bridge(", $cplusplusparams, ") : $name($pasparams) {}\n";
|
||||
}
|
||||
} elsif( $type eq "method" && $m->{Access} eq "protected" && $name =~ /.*Event$/ ) {
|
||||
;
|
||||
} elsif( $m->{Access} =~ /^protected/ ){
|
||||
if ( $returnType =~ "void" ) {
|
||||
print CLASS "\tvoid protected_$name(", $cplusplusparams, ") {\n",
|
||||
"\t\t", $class->{astNodeName}, "::$name($pasparams);\n",
|
||||
"\t\treturn;\n\t}\n";
|
||||
} else {
|
||||
print CLASS "\t$returnType protected_$name(", $cplusplusparams, ") {\n",
|
||||
"\t\treturn ($returnType) ", $class->{astNodeName}, "::$name($pasparams);\n\t}\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub listMember
|
||||
{
|
||||
my( $class, $m ) = @_;
|
||||
my $name;
|
||||
my $function;
|
||||
|
||||
$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 ($m->{ReturnType} eq "typedef") {
|
||||
} elsif( $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} =~ /QAuBucket/ || $m->{Params} =~ /QAuBucket/
|
||||
|| $m->{ReturnType} =~ /QMember/ || $m->{Params} =~ /QMember/ ) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $returnType = $m->{ReturnType};
|
||||
$returnType =~ s/const\s*//;
|
||||
$returnType =~ s/\s*([,\*\&])\s*/$1/;
|
||||
$returnType =~ s/^\s*//;
|
||||
$returnType =~ s/\s*$//;
|
||||
# map result type
|
||||
my $cplusplusreturntype=$returnType;
|
||||
if (kalyptusDataDict::pastypemap($returnType) ne "") {
|
||||
$cplusplusreturntype=kalyptusDataDict::ctypemap($returnType)
|
||||
}
|
||||
if ( $returnType ne "" && kalyptusDataDict::pastypemap($returnType) eq "" ) {
|
||||
print "'$returnType' => '$typeprefix$returnType',\n";
|
||||
} else {
|
||||
$returnType = kalyptusDataDict::pastypemap($returnType);
|
||||
}
|
||||
$returnType =~ s/var /P/;
|
||||
if ($returnType eq "var" || $returnType eq "const") {
|
||||
$returnType="pointer";
|
||||
}
|
||||
# TODO port to $m->{ParamList}
|
||||
my $pasparams = $m->{Params};
|
||||
my $cplusplusparams;
|
||||
my $argMod = "";
|
||||
my $cplusplusargs = "";
|
||||
$pasparams =~ s/\s+/ /g;
|
||||
$pasparams =~ s/\s*([,\*\&])\s*/$1 /g;
|
||||
$pasparams =~ s/^\s*void\s*$//;
|
||||
my $argId = 0;
|
||||
my @cargs = kdocUtil::splitUnnested(",", $pasparams);
|
||||
$pasparams = "";
|
||||
foreach my $arg ( @cargs ) {
|
||||
my $argType;
|
||||
my $cargType;
|
||||
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;
|
||||
# prepend with _ to avoid name conflicts
|
||||
$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/;
|
||||
# print $argType."\n";
|
||||
$cargType = kalyptusDataDict::pastypemap($argType);
|
||||
# print $cargType."\n";
|
||||
|
||||
if ( $argType =~ /^[A-Z][^:]*$/ && kalyptusDataDict::ctypemap($argType) eq "int" &&
|
||||
kalyptusDataDict::ctypemap($class->{astNodeName}."::".$argType) ne "" ) {
|
||||
$cplusplusargs .= "(".$class->{astNodeName}."::".$argType.")";
|
||||
} elsif ( $argType =~ /^\s*WFlags\s*$/ ) {
|
||||
$cplusplusargs .= "(QWidget::WFlags)";
|
||||
} elsif ( $argType =~ /^\s*ArrowType\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::ArrowType)";
|
||||
} elsif ( $argType =~ /^\s*Orientation\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::Orientation)";
|
||||
} elsif ( $argType =~ /^\s*BrushStyle\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::BrushStyle)";
|
||||
} elsif ( $argType =~ /^\s*BGMode\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::BGMode)";
|
||||
} elsif ( $argType =~ /^\s*PenCapStyle\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::PenCapStyle)";
|
||||
} elsif ( $argType =~ /^\s*PenStyle\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::PenStyle)";
|
||||
} elsif ( $argType =~ /^\s*PenJoinStyle\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::PenJoinStyle)";
|
||||
} elsif ( $argType =~ /^\s*RasterOp\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::RasterOp)";
|
||||
} elsif ( $argType =~ /^\s*TextFormat\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::TextFormat)";
|
||||
} elsif ( $argType =~ /^\s*QDragMode\s*$/ ) {
|
||||
$cplusplusargs .= "(QDragObject::DragMode)";
|
||||
} elsif ( $argType =~ /^\s*GUIStyle\s*$/ ) {
|
||||
$cplusplusargs .= "(Qt::GUIStyle)";
|
||||
} elsif ( $argType =~ /^\s*Type\s*$/ ) {
|
||||
$cplusplusargs .= "(QEvent::Type)";
|
||||
} else {
|
||||
$cplusplusargs .= "(".kalyptusDataDict::addNamespace($argType).")";
|
||||
}
|
||||
|
||||
if ( $cargType eq "" ) {
|
||||
print "'$argType' => '$typeprefix$argType',\n";
|
||||
$argType =~ s/\&.*$//;
|
||||
$pasparams .= $argMod." ".$arg." : ".$argType."; ";
|
||||
$cplusplusparams .= $argType." ".$arg.", ";
|
||||
} else {
|
||||
$cplusplusparams .= kalyptusDataDict::ctypemap($argType)." ".$arg.", ";
|
||||
my $pasargType=kalyptusDataDict::pastypemap($argType);
|
||||
if ($pasargType =~ s/^var//) {
|
||||
$argMod="var";
|
||||
} else {
|
||||
$argMod="";
|
||||
}
|
||||
# formal parameter?
|
||||
if ($pasargType eq "" && ($argMod eq "var" || $argMod eq "const")) {
|
||||
$pasparams .= $argMod." ".$arg."; ";
|
||||
} else {
|
||||
$pasparams .= $argMod." ".$arg." : ".$pasargType."; ";
|
||||
}
|
||||
}
|
||||
|
||||
if ( ( $cargType =~ /^qt_.*\*/ || $cargType =~ /^kde_.*\*/ ) && $argType =~ /^[^\*]*$/ ) {
|
||||
$argType =~ s/^(.*)\&.*$/$1/;
|
||||
$cplusplusargs .= "* (".kalyptusDataDict::addNamespace($argType)."*)".$arg.", ";
|
||||
} else {
|
||||
$cplusplusargs .= $arg.", ";
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
$pasparams =~ s/; $//;
|
||||
$cplusplusparams =~ s/, $//;
|
||||
$cplusplusargs =~ 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;
|
||||
}
|
||||
|
||||
if ( $name eq $class->{astNodeName} && $class->{Pure} ) {
|
||||
return;
|
||||
}
|
||||
|
||||
if ( defined $docnode ) {
|
||||
if ( defined $docnode->{Text} ) {
|
||||
print HEADER "\n{* ";
|
||||
my $node;
|
||||
my $line;
|
||||
foreach $node ( @{$docnode->{Text}} ) {
|
||||
next if $node->{NodeType} ne "DocText";
|
||||
$line = $node->{astNodeName};
|
||||
print HEADER $line, "\n";
|
||||
}
|
||||
print HEADER "}\n";
|
||||
}
|
||||
}
|
||||
# constructor
|
||||
if ( $name eq $class->{astNodeName} ) {
|
||||
print HEADER $extra,
|
||||
"function ", $typeprefix, "new_", $function,
|
||||
"(", $pasparams, ") : ".$name."H;cdecl;\n";
|
||||
@functions[$#functions+1]="function ". $typeprefix. "new_". $function.
|
||||
"(".$pasparams.") : ".$name."H;cdecl;external name ".
|
||||
"'".$typeprefix. "new_". $function. "';";
|
||||
print CLASS $extra,
|
||||
$typeprefix, $name, " * ", $typeprefix, "new_", $function,
|
||||
"(", $cplusplusparams, "){\n",
|
||||
"\treturn (", $typeprefix, $name, " *) new ", $name, "Bridge(", $cplusplusargs, ");\n}\n";
|
||||
# destructor
|
||||
} elsif ( $returnType =~ /~/ ) {
|
||||
print HEADER $extra,
|
||||
"procedure ", $typeprefix, "del_", $function,
|
||||
"(p : ", $class->{astNodeName}, "H);cdecl;\n";
|
||||
@functions[$#functions+1]="procedure ".$typeprefix. "del_". $function.
|
||||
"(p : ".$class->{astNodeName}."H);cdecl;external name ".
|
||||
"'". $typeprefix. "del_". $function."';";
|
||||
if (exists $class->{Pure} || $constructorCount == 0) {
|
||||
print CLASS $extra,
|
||||
"void ", $typeprefix, "del_", $function,
|
||||
"( ", $typeprefix, $class->{astNodeName}, "* p ){\n\tdelete (", kalyptusDataDict::addNamespace($class->{astNodeName}), "*) p;\n}\n";
|
||||
} else {
|
||||
print CLASS $extra,
|
||||
"void ", $typeprefix, "del_", $function,
|
||||
"( ", $typeprefix, $class->{astNodeName}, "* p ){\n\tdelete (", $class->{astNodeName}, "Bridge*) p;\n}\n";
|
||||
}
|
||||
} 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::";
|
||||
}
|
||||
if ($returnType eq "void") {
|
||||
print HEADER "procedure ",
|
||||
$class->{astNodeName}, "_", $function,
|
||||
"(", $pasparams, ");cdecl;\n";
|
||||
@functions[$#functions+1]="procedure ".
|
||||
$class->{astNodeName}."_".$function.
|
||||
"(".$pasparams.");cdecl;external name ".
|
||||
"'".$typeprefix . $class->{astNodeName} . "_".$function."';";
|
||||
|
||||
} else {
|
||||
print HEADER "function ",
|
||||
$class->{astNodeName}, "_", $function,
|
||||
"(", $pasparams, ") : ".$returnType.";cdecl;\n";
|
||||
@functions[$#functions+1]="function ".
|
||||
$class->{astNodeName}."_".$function.
|
||||
"(".$pasparams.") : ".$returnType.";cdecl;external name ".
|
||||
"'".$typeprefix . $class->{astNodeName} . "_".$function."';";
|
||||
}
|
||||
print CLASS $cplusplusreturntype,
|
||||
" ", $typeprefix, $class->{astNodeName}, "_", $function,
|
||||
"( ", $cplusplusparams, "){\n";
|
||||
} else {
|
||||
if ( exists $class->{Pure} || $constructorCount == 0 ) {
|
||||
$selfstring = "((".kalyptusDataDict::addNamespace($class->{astNodeName})."*)instPointer)->";
|
||||
} else {
|
||||
$selfstring = "((".$class->{astNodeName}."Bridge*)instPointer)->";
|
||||
}
|
||||
if ($returnType eq "void") {
|
||||
print HEADER "procedure ",
|
||||
$class->{astNodeName}, "_", $function,
|
||||
"(", "instPointer : ", $class->{astNodeName}, "H", ($pasparams eq "" ? "" : ";"), $pasparams, ");cdecl;\n";
|
||||
@functions[$#functions+1]="procedure ".
|
||||
$class->{astNodeName}."_".$function.
|
||||
"("."instPointer : ".$class->{astNodeName}."H".($pasparams eq "" ? "" : ";").$pasparams.
|
||||
");cdecl;external name ".
|
||||
"'".$typeprefix . $class->{astNodeName} . "_".$function."';";
|
||||
} else {
|
||||
print HEADER "function ",
|
||||
$class->{astNodeName}, "_", $function,
|
||||
"(", "instPointer : ", $class->{astNodeName}, "H", ($pasparams eq "" ? "" : ";"), $pasparams, ") : ",
|
||||
$returnType,";cdecl;\n";
|
||||
@functions[$#functions+1]="function ".
|
||||
$class->{astNodeName}."_".$function.
|
||||
"("."instPointer : ".$class->{astNodeName}."H".($pasparams eq "" ? "" : ";").$pasparams.
|
||||
") : ".$returnType.";cdecl;external name ".
|
||||
"'".$typeprefix . $class->{astNodeName} . "_".$function."';";
|
||||
}
|
||||
print CLASS $cplusplusreturntype,
|
||||
" ", $typeprefix, $class->{astNodeName}, "_", $function,
|
||||
"( ", $typeprefix, $class->{astNodeName}, "* instPointer", ($cplusplusparams eq "" ? "" : ","), $cplusplusparams, "){\n";
|
||||
}
|
||||
if ( $cplusplusreturntype =~ /^\s*void\s*$/ ) {
|
||||
print CLASS "\t", $selfstring, $name, "(", $cplusplusargs, ");\n\treturn;\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QBrush\s*$/ ) {
|
||||
print CLASS "\tQBrush _b= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QBrush(_b.color(),_b.style());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QColorGroup\s*$/ ) {
|
||||
print CLASS "\tQColorGroup _c= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QColorGroup(_c.foreground(),_c.background(),_c.light(),_c.dark(),_c.mid(),_c.text(),_c.base());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QDateTime\s*$/ ) {
|
||||
print CLASS "\tQDateTime _dt= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QDateTime (_dt.date(),_dt.time());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QDate\s*$/ ) {
|
||||
print CLASS "\tQDate _d= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QDate(_d.year(),_d.month(),_d.day());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QPen\s*$/ ) {
|
||||
print CLASS "\tQPen _b= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QPen(_b.color(),_b.width(),_b.style());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QPoint\s*\&?\s*$/ ) {
|
||||
print CLASS "\tQPoint _p= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QPoint(_p.x(),_p.y());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QRect\s*$/ ) {
|
||||
print CLASS "\tQRect _r= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QRect(_r.left(),_r.top(),_r.width(),_r.height());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QSizePolicy\s*$/ ) {
|
||||
print CLASS "\tQSizePolicy _s= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QSizePolicy(_s.horData(),_s.verData(),_s.hasHeightForWidth());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QSize\s*$/ ) {
|
||||
print CLASS "\tQSize _s= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QSize(_s.width(),_s.height());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QStyle\s*$/ ) {
|
||||
print CLASS "\tQStyle * _s= \&", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ") _s;\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QTime\s*$/ ) {
|
||||
print CLASS "\tQTime _t= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QTime(_t.hour(),_t.minute(),_t.second(),_t.msec());\n}\n" ;
|
||||
} elsif ( $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?QWMatrix\s*$/ ) {
|
||||
print CLASS "\tQWMatrix _m= ", $selfstring, $name, "(", $cplusplusargs, ");\n" ;
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new QWMatrix(_m.m11(),_m.m12(),_m.m21(),_m.m22(),_m.dx(),_m.dy());\n}\n" ;
|
||||
} elsif ( ($cplusplusreturntype =~ /qt_/ || $returnType =~ /kde_/)
|
||||
&& $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?(\w*)\s*$/ )
|
||||
{
|
||||
my $valueType = kalyptusDataDict::addNamespace($3);
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ")new $valueType(", $selfstring, $name, "(", $cplusplusargs, "));\n}\n"; ;
|
||||
} elsif ( ($cplusplusreturntype =~ /qt_/ || $cplusplusreturntype =~ /kde_/)
|
||||
&& $m->{ReturnType} =~ /^\s*(inline)?\s*(const)?\s*?(\w*)\s*\&?\s*$/ )
|
||||
{
|
||||
my $constOpt = $2;
|
||||
my $valueType = kalyptusDataDict::addNamespace($3);
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ") ($constOpt $valueType *)\&", $selfstring, $name, "(", $cplusplusargs, ");\n}\n"; ;
|
||||
} else {
|
||||
print CLASS "\treturn (", $cplusplusreturntype, ") ", $selfstring, $name, "(", $cplusplusargs, ");\n}\n" ;
|
||||
}
|
||||
}
|
||||
} elsif( $type eq "enum" ) {
|
||||
# Convert each enum value to '#define <uppercased class name>_<enum name> <enum value>'
|
||||
my $enum = $m->{astNodeName};
|
||||
my $enumname = $enum;
|
||||
my %enumMap = ();
|
||||
|
||||
# Add a C++ to C type mapping for this enum - ie an int in C
|
||||
$enum =~ s/\s//g;
|
||||
|
||||
kalyptusDataDict::setpastypemap($enum, $class->{astNodeName}.$enumname);
|
||||
kalyptusDataDict::setctypemap($enum, 'int');
|
||||
$enum = $class->{astNodeName}."::".$enum;
|
||||
kalyptusDataDict::setpastypemap($enum, $class->{astNodeName}.$enumname);
|
||||
# add C mapping as well
|
||||
kalyptusDataDict::setctypemap($enum, 'int');
|
||||
|
||||
@typeenums[$#typeenums+1]= " ".$class->{astNodeName}.$enumname." = (\n";
|
||||
my @enums = split(",", $m->{Params});
|
||||
my $first = 1;
|
||||
foreach my $enum ( @enums ) {
|
||||
if ($first!=1) {
|
||||
@typeenums[$#typeenums+1]=",\n";
|
||||
}
|
||||
$first=0;
|
||||
$enum =~ s/\s//g;
|
||||
if ( $enum =~ /(.*)=(.*)\s*(\||\&|>>|<<|\+)\s*(.*)/ ) {
|
||||
# !!!! needs to be evaluted here
|
||||
# or'd, and'd or shifted pair of values
|
||||
@typeenums[$#typeenums+1]=" ".$class->{astNodeName}.$enumname."_".$1; # !!!!. "\t:= ".
|
||||
#!!!! ($enumMap{$2} eq "" ? $2 : "dword(".$enumMap{$2}.")").$pasopmap{$3}. ($enumMap{$4} eq "" ? $4 : "dword(".$enumMap{$4}.")");
|
||||
$enumMap{$1} = $class->{astNodeName}.$enumname."_".$1;
|
||||
} elsif ( $enum =~ /(.*)=(.*)/ ) {
|
||||
@typeenums[$#typeenums+1]=" ".kalyptusDataDict::pasenummap($class->{astNodeName}.
|
||||
$enumname."_".$1)."\t:= ".($enumMap{$2} eq "" ? changehex($2) : $enumMap{$2});
|
||||
$enumMap{$1} = $class->{astNodeName}.$enumname."_".$1;
|
||||
} else {
|
||||
@typeenums[$#typeenums+1]=" ".$class->{astNodeName}.$enumname."_".$enum;
|
||||
$enumMap{$enum} = $class->{astNodeName}.$enumname."_".$enum;
|
||||
}
|
||||
}
|
||||
@typeenums[$#typeenums+1]="\n );\n\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
#
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user