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 =<$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 ' = ' 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 _ ' 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; #