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.
tdebindings/kalyptus/kalyptusCxxToJava.pm

3435 lines
119 KiB

#***************************************************************************
# kalyptusCxxToJava.pm - Generates *.java files for a Dynamic Proxy
# based smoke adaptor
# -------------------
# begin : Fri Jan 25 12:00:00 2003
# copyright : (C) 2003, Richard Dale. All Rights Reserved.
# email : Richard_Dale@tipitina.demon.co.uk
# author : Richard Dale, based on the SMOKE generation code
# by David Faure.
#***************************************************************************/
#/***************************************************************************
# * *
# * 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 kalyptusCxxToJava;
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/
$libname $rootnode $outputdir $opt $debug
$qapplicationExtras $qbitmapExtras
$qlistviewExtras $qlistviewitemExtras
$qdragobjectExtras $qdropeventExtras $qmimesourceExtras
$qtExtras $qobjectExtras $qwidgetExtras
$qpixmapExtras $qpaintdeviceExtras
$qdragobjectExtras $qiodeviceExtras $qpointarrayExtras
$qtextcodecExtras $quridragExtras
$kapplicationExtras $kmainwindowExtras
$methodNumber
%builtins %typeunion %allMethods %allTypes %enumValueToType %typedeflist %mungedTypeMap %javaImports
%skippedClasses %operatorNames /;
BEGIN
{
# Types supported by the StackItem union
# Key: C++ type Value: Union field of that type
%typeunion = (
'void*' => 's_voidp',
'bool' => 's_bool',
'char' => 's_char',
'uchar' => 's_uchar',
'short' => 's_short',
'ushort' => 's_ushort',
'int' => 's_int',
'uint' => 's_uint',
'long' => 's_long',
'ulong' => 's_ulong',
'float' => 's_float',
'double' => 's_double',
'enum' => 's_enum',
'class' => 's_class'
);
# Mapping for iterproto, when making up the munged method names
%mungedTypeMap = (
'TQString' => '$',
'TQString*' => '$',
'TQString&' => '$',
'TQCString' => '$',
'TQCString*' => '$',
'TQCString&' => '$',
'TQByteArray' => '$',
'TQByteArray&' => '$',
'TQByteArray*' => '$',
'char*' => '$',
'TQCOORD*' => '?',
'TQRgb*' => '?',
);
# Yes some of this is in kalyptusDataDict's ctypemap
# but that one would need to be separated (builtins vs normal classes)
%typedeflist =
(
'signed char' => 'char',
'unsigned char' => 'uchar',
'signed short' => 'short',
'unsigned short' => 'ushort',
'signed' => 'int',
'signed int' => 'int',
'unsigned' => 'uint',
'unsigned int' => 'uint',
'KIO::filesize_t' => 'long',
'signed long' => 'long',
'unsigned long' => 'ulong',
# Anything that is not known is mapped to void*, so no need for those here anymore
# 'TQWSEvent*' => 'void*',
# 'TQDiskFont*' => 'void*',
# 'XEvent*' => 'void*',
# 'FILE*' => 'void*',
# 'TQUnknownInterface*' => 'void*',
# 'GDHandle' => 'void*',
# '_NPStream*' => 'void*',
# 'TQTextFormat*' => 'void*',
# 'TQTextDocument*' => 'void*',
# 'TQTextCursor*' => 'void*',
# 'TQTextParag**' => 'void*',
# 'TQTextParag*' => 'void*',
# 'TQRemoteInterface*' => 'void*',
# 'TQSqlRecordPrivate*' => 'void*',
# 'TQTSMFI' => 'void*', # TQTextStream's TQTSManip
# 'const GUID&' => 'void*',
# 'TQWidgetMapper*' => 'void*',
# 'MSG*' => 'void*',
# 'const TQSqlFieldInfoList&' => 'void*', # TQSqlRecordInfo - TODO (templates)
'TQStyleHintReturn*' => 'void*',
'TQPtrCollection::Item' => 'void*', # to avoid a warning
'mode_t' => 'long',
'TQProcess::PID' => 'long',
'size_type' => 'int', # TQSqlRecordInfo
'TQt::ComparisonFlags' => 'uint',
'TQt::ToolBarDock' => 'int', # compat thing, Qt shouldn't use it
'TQIODevice::Offset' => 'ulong',
'WState' => 'int',
'WId' => 'ulong',
'TQRgb' => 'uint',
'ksocklen_t' => 'uint',
'TQCOORD' => 'int',
'TQTSMFI' => 'int',
'TQt::WState' => 'int',
'TQt::WFlags' => 'int',
'TQt::HANDLE' => 'uint',
'TQEventLoop::ProcessEventsFlags' => 'uint',
'TQStyle::SCFlags' => 'int',
'TQStyle::SFlags' => 'int',
'Q_INT16' => 'short',
'Q_INT32' => 'int',
'Q_INT64' => 'long',
'Q_INT8' => 'char',
'Q_LONG' => 'long',
'Q_LLONG' => 'long',
'Q_ULLONG' => 'long',
'Q_UINT16' => 'ushort',
'Q_UINT32' => 'uint',
'Q_UINT64' => 'long',
'Q_UINT8' => 'uchar',
'Q_ULONG' => 'long',
'pid_t' => 'int',
'size_t' => 'int',
'pid_t' => 'int',
'time_t' => 'int',
'short int' => 'short',
'unsigned long long int' => 'ulong',
'long long int' => 'long',
'signed long int' => 'long',
'unsigned long int' => 'ulong',
'int long' => 'long',
'unsigned short int' => 'ushort',
);
%operatorNames =
(
'operator^' => 'op_xor',
'operator^=' => 'op_xor_assign',
'operator<' => 'op_lt',
'operator<<' => 'op_write',
'operator<=' => 'op_lte',
# 'operator=' => 'op_assign',
'operator==' => 'op_equals',
'operator>' => 'op_gt',
'operator>=' => 'op_gte',
'operator>>' => 'op_read',
'operator|' => 'op_or',
'operator|=' => 'op_or_assign',
'operator-' => 'op_minus',
'operator-=' => 'op_minus_assign',
'operator--' => 'op_decr',
'operator!' => 'op_not',
'operator!=' => 'op_not_equals',
'operator/' => 'op_div',
'operator/=' => 'op_div_assign',
'operator()' => 'op_expr',
'operator[]' => 'op_at',
'operator*' => 'op_mult',
'operator*=' => 'op_mult_assign',
'operator&' => 'op_and',
'operator&=' => 'op_and_assign',
'operator+' => 'op_plus',
'operator+=' => 'op_plus_assign',
'operator++' => 'op_incr',
);
$qapplicationExtras = <<EOF;
// public native String[] args();
EOF
$qbitmapExtras = <<EOF;
// public TQBitmap(TQPixmap arg1) {
// super((Class) null);
// newTQBitmap(arg1);
// }
// private native void newTQBitmap(TQPixmap arg1);
// public TQBitmap(TQImage arg1) {
// super((Class) null);
// newTQBitmap(arg1);
// }
// private native void newTQBitmap(TQImage arg1);
EOF
$qlistviewExtras = <<EOF;
// public native ArrayList itemList();
EOF
$qlistviewitemExtras = <<EOF;
public native ArrayList itemList();
EOF
$qtExtras = <<EOF;
/** This member allows a typecast of an instance which wraps a Qt instance,
to a more specialized type. Invokes the private qtjava.dynamicCast()
via reflection, as that method isn't part of the public Qt api */
public static QtSupport dynamicCast(String type, QtSupport source) {
Method method = null;
try {
method = qtjava.class.getDeclaredMethod( "dynamicCast",
new Class[] { String.class, QtSupport.class } );
} catch (NoSuchMethodException e1) {
Qt.tqWarning("No such method : qtjava.dynamicCast()");
}
try {
method.setAccessible(true);
Object result = method.invoke(qtjava.class, new Object[] { type, source } );
return (QtSupport) result;
} catch (InvocationTargetException e) {
Qt.tqWarning("Invocation failed : qtjava.dynamicCast()");
return null;
} catch (IllegalAccessException e) {
Qt.tqWarning("Invocation failed : qtjava.dynamicCast()");
return null;
}
}
/*
public static native TQColor color0();
public static native TQColor color1();
public static native TQColor black();
public static native TQColor white();
public static native TQColor darkGray();
public static native TQColor gray();
public static native TQColor lightGray();
public static native TQColor red();
public static native TQColor green();
public static native TQColor blue();
public static native TQColor cyan();
public static native TQColor magenta();
public static native TQColor yellow();
public static native TQColor darkRed();
public static native TQColor darkGreen();
public static native TQColor darkBlue();
public static native TQColor darkCyan();
public static native TQColor darkMagenta();
public static native TQColor darkYellow();
// Global cursors
public static native TQCursor arrowCursor(); // standard arrow cursor
public static native TQCursor upArrowCursor(); // upwards arrow
public static native TQCursor crossCursor(); // crosshair
public static native TQCursor waitCursor(); // hourglass/watch
public static native TQCursor ibeamCursor(); // ibeam/text entry
public static native TQCursor sizeVerCursor(); // vertical resize
public static native TQCursor sizeHorCursor(); // horizontal resize
public static native TQCursor sizeBDiagCursor(); // diagonal resize (/)
public static native TQCursor sizeFDiagCursor(); // diagonal resize (\)
public static native TQCursor sizeAllCursor(); // all directions resize
public static native TQCursor blankCursor(); // blank/invisible cursor
public static native TQCursor splitVCursor(); // vertical bar with left-right
// arrows
public static native TQCursor splitHCursor(); // horizontal bar with up-down
// arrows
public static native TQCursor pointingHandCursor(); // pointing hand
public static native TQCursor forbiddenCursor(); // forbidden cursor (slashed circle)
*/
// public static native TQApplication tqApp();
public static native void tqDebug(String message);
public static void tqDebug(String pattern, Object[] arguments) {
tqDebug(MessageFormat.format(pattern, arguments));
}
public static native void tqWarning(String message);
public static void tqWarning(String pattern, Object[] arguments) {
tqWarning(MessageFormat.format(pattern, arguments));
}
public static native void tqFatal(String message);
public static void tqFatal(String pattern, Object[] arguments) {
tqFatal(MessageFormat.format(pattern, arguments));
}
private static String sqeezeOut(String from, char toss) {
char[] chars = from.toCharArray();
int len = chars.length;
int put = 0;
for (int i = 0; i < len; i++) {
if (chars[i] != toss) {
chars[put++] = chars[i];
}
}
return new String(chars, 0, put);
}
/** Prepend a '2' to a signal string and remove any spaces */
public static String SIGNAL(String signal) {
return "2" + sqeezeOut(signal, ' ');
}
/** Prepend a '1' to a slot string and remove any spaces */
public static String SLOT(String slot) {
return "1" + sqeezeOut(slot, ' ');
}
/** Convert from a UTF-8 string to Unicode - the java equivalent to TQString::fromUtf8() */
public String fromUtf8(byte[] bytes) {
String result = null;
try {
result = new String(bytes, "UTF-8");
} catch (UnsupportedEncodingException e) {
tqWarning("UTF-8 encoding not supported");
} finally {
return result;
}
}
EOF
$qobjectExtras = <<EOF;
/** i18n() is just a synonym of tr() for now */
public static String i18n(String s) {
return tr(s);
}
EOF
$qwidgetExtras = <<EOF;
EOF
$qpixmapExtras = <<EOF;
// public native boolean loadFromData(char[] data);
EOF
$qpaintdeviceExtras = <<EOF;
EOF
$qdragobjectExtras = <<EOF;
EOF
$qdropeventExtras = <<EOF;
EOF
$qmimesourceExtras = <<EOF;
EOF
$qiodeviceExtras = <<EOF;
public static final int IO_Direct = 0x0100; // direct access device
public static final int IO_Sequential = 0x0200; // sequential access device
public static final int IO_Combined = 0x0300; // combined direct/sequential
public static final int IO_TypeMask = 0x0f00;
// IO handling modes
public static final int IO_Raw = 0x0040; // raw access (not buffered)
public static final int IO_Async = 0x0080; // asynchronous mode
// IO device open modes
public static final int IO_ReadOnly = 0x0001; // readable device
public static final int IO_WriteOnly = 0x0002; // writable device
public static final int IO_ReadWrite = 0x0003; // read+write device
public static final int IO_Append = 0x0004; // append
public static final int IO_Truncate = 0x0008; // truncate device
public static final int IO_Translate = 0x0010; // translate CR+LF
public static final int IO_ModeMask = 0x00ff;
// IO device state
public static final int IO_Open = 0x1000; // device is open
public static final int IO_StateMask = 0xf000;
// IO device status
public static final int IO_Ok = 0;
public static final int IO_ReadError = 1; // read error
public static final int IO_WriteError = 2; // write error
public static final int IO_FatalError = 3; // fatal unrecoverable error
public static final int IO_ResourceError = 4; // resource limitation
public static final int IO_OpenError = 5; // cannot open device
public static final int IO_ConnectError = 5; // cannot connect to device
public static final int IO_AbortError = 6; // abort error
public static final int IO_TimeOutError = 7; // time out
public static final int IO_UnspecifiedError = 8; // unspecified error
EOF
$qpointarrayExtras = <<EOF;
// public native int size();
// public native int count();
// public native boolean isEmpty();
// public native boolean isNull();
// public native boolean resize( int size);
// public native boolean truncate( int pos);
// public native int begin();
// public native int end();
// public native TQPoint at(int index);
EOF
$quridragExtras = <<EOF;
// public static native boolean decode(TQMimeSourceInterface e, ArrayList i);
// public static native boolean decodeToUnicodeUris(TQMimeSourceInterface e, ArrayList i);
// public static native boolean decodeLocalFiles(TQMimeSourceInterface e, ArrayList i);
EOF
$kapplicationExtras = <<EOF;
/**
Used internally by the KDE Koala Java bindings runtime
*/
// public static native void setJavaSlotFactory();
EOF
$kmainwindowExtras = <<EOF;
/**
List of members of KMainWindow class.
*/
// public native ArrayList memberList();
public static void RESTORE(String typeName) {
Class savedClass;
try {
savedClass = Class.forName(typeName);
int n = 1;
while (KMainWindow.canBeRestored(n)){
((KMainWindow) savedClass.newInstance()).restore(n);
n++;
}
} catch(Exception e) {
return;
}
return;
}
EOF
}
sub javaImport($)
{
my ( $classname ) = @_;
my $classname_ptr = $classname . "*";
if ( cplusplusToJava($classname_ptr) eq "" or $classname eq $main::globalSpaceClassName ) {
return "";
} elsif ( cplusplusToJava($classname_ptr) eq "ArrayList" ) {
return "java.util.ArrayList";
} elsif ( cplusplusToJava($classname_ptr) eq "Calendar" ) {
return "java.util.Calendar";
} elsif ( cplusplusToJava($classname_ptr) eq "StringBuffer" ) {
return "";
} elsif ( cplusplusToJava($classname_ptr) eq "String" ) {
return "";
} elsif ( cplusplusToJava($classname_ptr) eq "String[][]" ) {
return "";
} elsif ( cplusplusToJava($classname_ptr) eq "String[]" ) {
return "";
} elsif ( cplusplusToJava($classname_ptr) eq "Date" ) {
return "java.util.Date";
} elsif ( cplusplusToJava($classname_ptr) =~ /^[a-z]/ ) {
return "";
} elsif ( $classname =~ /^Q/ ) {
return "org.kde.qt." . $classname;
} else {
return "org.kde.koala." . $classname;
}
}
sub cplusplusToJava
{
my ( $cplusplusType ) = @_;
my $isConst = ($cplusplusType =~ /const / or $cplusplusType !~ /[*&]/ ? 1 : 0);
$cplusplusType =~ s/const //;
$cplusplusType =~ s/^signed//;
my $className = $cplusplusType;
$className =~ s/[*&]//;
if ( $cplusplusType =~ /void\*|KHTMLPart::PageSecurity|TQFileInfoList|TQValueList<TQIconDragItem>|TQValueList<TQCString>|TQValueList<TQVariant>|TQValueList<TQPixmap>|TQValueListConstIterator<TQString>|TQMap|EditMode|TQPtrList<TQPixmap>|TQPtrList<TQPoint>|TQTextFormat|TQTextCursor|TQTextDocument|TQNetworkProtocolFactoryBase|TQDomNodePrivate|TQSqlDriverCreatorBase|TQSqlFieldInfoList|TQObjectUserData|TQUObject|TQTextParag|TQWidgetMapper|TQMemArray<int>|TQBitArray|TQLayoutIterator|TQAuBucket|TQUnknownInterface|TQConnectionList/ ) {
return ""; # Unsupported type
} elsif ( $cplusplusType =~ /bool/ && kalyptusDataDict::ctypemap($cplusplusType) eq "int" ) {
return "boolean";
} elsif ( $cplusplusType =~ /bool\s*[*&]/ ) {
return "boolean[]";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /^void\s*\*/ ) {
return "int";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /^\s*(unsigned )?int\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /^qt_QIntValueList\*/
|| $cplusplusType =~ /^int[*&]$/ )
{
return "int[]";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /^\s*double\s*\*/ ) {
return "double[]";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /^\s*(unsigned )?short\s*\*/ ) {
return "short[]";
} elsif ( $cplusplusType =~ /KCmdLineOptions/ ) {
return "String[][]";
} elsif ( $cplusplusType =~ /char\s*\*\*/ || $cplusplusType =~ /TQStringList/|| $cplusplusType =~ /TQStrList/) {
return "String[]";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QUrlInfoValueList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QVariantValueList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QIconDragItemValueList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QPixmapValueList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_QCStringList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QObjectList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QDomNodeList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QWidgetList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_KURLList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_KMainWindow\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_KFileItemList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_KFileViewItemList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_DOMNodeList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_StyleSheetList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_MediaList\s*\*/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_OfferList\s*\*/
|| $cplusplusType =~ /TQMemArray<TQRect>/
|| kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QCanvasItemList\s*\*/ ) {
return "ArrayList"
} elsif ( $cplusplusType =~ /uchar\s*\*/ ) {
return "char[]";
} elsif ( $cplusplusType =~ /QC?String/ and !$isConst ) {
return "StringBuffer"
} elsif ( $cplusplusType =~ /(DOM::)?DOMString/ || $cplusplusType =~ /TQString/ || $cplusplusType =~ /TQCString/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /^(const )?char\s*\*/ ) {
return "String"
} elsif ( $cplusplusType =~ /TQChar\s*[&\*]?/ || $cplusplusType =~ /^char$/ ) {
return "char"
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QTime\s*\*/ ) {
return "Date"
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QDateTime\s*\*/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_QDate\s*\*/ ) {
return "Calendar"
} elsif ( $cplusplusType =~ /TQPaintDevice/ ) {
return "TQPaintDeviceInterface"
} elsif ( $cplusplusType =~ /TQByteArray/ ) {
return "byte[]"
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /qt_([^\*\s]*)(.*)$/ and !$skippedClasses{$className}) {
if ( kalyptusDataDict::interfacemap($1) ne () ) {
return $1."Interface";
} else {
return $1;
}
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /kde_([^\*\s]*)(.*)$/ and !$skippedClasses{$className}) {
if ( kalyptusDataDict::interfacemap($1) ne () ) {
return $1."Interface";
} else {
return $1;
}
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /unsigned char/ ) {
return "short";
} elsif ( $typedeflist{$cplusplusType} =~ /ulong|long/ ) {
return "long";
} elsif ( $typedeflist{$cplusplusType} =~ /uint|int/ or $cplusplusType =~ /^int\&$/ ) {
return "int";
} elsif ( $typedeflist{$cplusplusType} =~ /ushort|short/ ) {
return "short";
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /(unsigned )(.*)/ ) {
return $2;
} else {
my $node;
my $item;
if ($className =~ /^(\w+)::(\w+)$/) {
$node = kdocAstUtil::findRef( $rootnode, $1 );
$item = kdocAstUtil::findRef( $node, $2 ) if defined $node;
if (defined $item && $item->{NodeType} eq 'enum') {
return "int";
} elsif (defined $item && ($item->{NodeType} eq 'class' || $item->{NodeType} eq 'struct')) {
return $skippedClasses{$className} ? "" : $2;
}
}
if ($className =~ /^\w+$/) {
$item = kdocAstUtil::findRef( $rootnode, $className );
if (defined $item && ($item->{NodeType} eq 'class' || $item->{NodeType} eq 'struct')) {
return $skippedClasses{$className} ? "" : $className;
}
}
return kalyptusDataDict::ctypemap($cplusplusType);
}
}
sub writeDoc
{
( $libname, $rootnode, $outputdir, $opt ) = @_;
print STDERR "Starting writeDoc for $libname...\n";
$debug = $main::debuggen;
mkpath( $outputdir ) unless -f $outputdir;
# Define TQPtrCollection::Item, for resolveType
unless ( kdocAstUtil::findRef( $rootnode, "TQPtrCollection::Item" ) ) {
my $cNode = kdocAstUtil::findRef( $rootnode, "TQPtrCollection" );
warn "TQPtrCollection not found" if (!$cNode);
my $node = Ast::New( 'Item' );
$node->AddProp( "NodeType", "Forward" );
$node->AddProp( "Source", $cNode->{Source} ) if ($cNode);
kdocAstUtil::attachChild( $cNode, $node ) if ($cNode);
$node->AddProp( "Access", "public" );
}
print STDERR "Preparsing...\n";
# Preparse everything, to prepare some additional data in the classes and methods
Iter::LocalCompounds( $rootnode, sub { preParseClass( shift ); } );
# Have a look at each class again, to propagate CanBeCopied
Iter::LocalCompounds( $rootnode, sub { propagateCanBeCopied( shift ); } );
# Write out smokedata.cpp
writeSmokeDataFile($rootnode);
print STDERR "Writing *.java...\n";
# Generate *java file for each class
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
print STDERR "Done.\n";
}
=head2 preParseClass
Called for each class
=cut
sub preParseClass
{
my( $classNode ) = @_;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
if( $#{$classNode->{Kids}} < 0 ||
$classNode->{Access} eq "private" ||
$classNode->{Access} eq "protected" || # e.g. TQPixmap::TQPixmapData
exists $classNode->{Tmpl} ||
# Don't generate standard bindings for TQString, this class is handled as a native type
$className eq 'TQString' ||
$className eq 'TQConstString' ||
$className eq 'TQCString' ||
# Don't map classes which are really arrays
$className eq 'TQStringList' ||
$className eq 'TQCanvasItemList' ||
$className eq 'TQWidgetList' ||
$className eq 'TQObjectList' ||
$className eq 'TQStrList' ||
# Those are template related
$className eq 'TQTSManip' || # cause compiler errors with several gcc versions
$className eq 'TQIconFactory' ||
$className eq 'TQGDict' ||
$className eq 'TQGList' ||
$className eq 'TQGVector' ||
$className eq 'TQStrIList' ||
$className eq 'TQStrIVec' ||
$className eq 'TQByteArray' ||
$className eq 'TQBitArray' ||
$className eq 'TQWExtra' ||
$className eq 'TQTLWExtra' ||
$className eq 'TQMetaEnum::Item' ||
$className eq 'TQWidgetContainerPlugin' ||
$className eq 'TQGArray::array_data' ||
$className eq 'KBookmarkMenu::DynMenuInfo' ||
$className eq 'KCompletionMatches' ||
$className eq 'KDEDesktopMimeType::Service' ||
$className eq 'KGlobalSettings::KMouseSettings' ||
$className eq 'KMimeType::Format' ||
$className eq 'KNotifyClient::Instance' ||
$className eq 'KParts::Plugin::PluginInfo' ||
$className eq 'KProtocolInfo::ExtraField' ||
$className eq 'KXMLGUIClient::StateChange' ||
$className eq 'KIconTheme' ||
$className eq 'KEditListBox::CustomEditor' ||
$className eq 'KIO::KBookmarkMenuNSImporter' ||
$className eq 'KPerDomainSettings' ||
$className eq 'KApplicationPropsPlugin' ||
$className eq 'KPrinter' ||
$className eq 'KPty' ||
$className eq 'KOpenWithHandler' ||
$className eq 'KFileOpenWithHandler' ||
$className eq 'KBindingPropsPlugin' ||
$className eq 'KPropsDlgPlugin' ||
$className eq 'KFileSharePropsPlugin' ||
$className eq 'KBookmarkMenuNSImporter' ||
$className eq 'KDevicePropsPlugin' ||
$className eq 'KWin::WindowInfo' ||
$className eq 'KDEDModule' ||
$className eq 'KFileMetaInfoProvider' ||
$className eq 'KFileMimeTypeInfo' ||
$className eq 'KExecPropsPlugin' ||
$className eq 'KFilePermissionsPropsPlugin' ||
$className eq 'KImageFilePreview' ||
$className eq 'KBookmarkManager' ||
$className eq 'KBookmarkNotifier' ||
$className eq 'KOCRDialogFactory' ||
$className eq 'KExtendedBookmarkOwner' ||
$className eq 'KSharedPixmap' ||
$className eq 'KSocket' ||
$className eq 'KLibrary' ||
$className eq 'KScanDialogFactory' ||
$className eq 'KDictSpellingHighlighter' ||
$className eq 'KPropertiesDialog' ||
$className eq 'ProgressItem' ||
$className eq 'KIO::ChmodInfo' ||
$className eq 'KIO::MetaData' ||
$className eq 'KFileMimeTypeInfo::ItemInfo' ||
$className eq 'KIO::UDSAtom' ||
$className eq 'khtml::DrawContentsEvent' || # the khtml:: classes build, but don't link
$className eq 'khtml::MouseDoubleClickEvent' ||
$className eq 'khtml::MouseMoveEvent' ||
$className eq 'khtml::MousePressEvent' ||
$className eq 'khtml::MouseReleaseEvent' ||
$className eq 'khtml::MouseEvent' ||
$className eq 'KURL::List' ||
$className eq 'KWin::Info' ||
$className eq 'TerminalInterface' ||
$className =~ /.*Private$/ || # Ignore any classes which aren't for public consumption
$className =~ /.*Impl$/ ||
$className =~ /.*Internal.*/ ||
# $classNode->{Deprecated} ||
$classNode->{NodeType} eq 'union' # Skip unions for now, e.g. TQPDevCmdParam
) {
print STDERR "Skipping $className\n" if ($debug);
print STDERR "Skipping union $className\n" if ( $classNode->{NodeType} eq 'union');
$skippedClasses{$className} = 1;
delete $classNode->{Compound}; # Cheat, to get it excluded from Iter::LocalCompounds
return;
}
my $signalCount = 0;
my $eventHandlerCount = 0;
my $defaultConstructor = 'none'; # none, public, protected or private. 'none' will become 'public'.
my $constructorCount = 0; # total count of _all_ ctors
# If there are ctors, we need at least one public/protected one to instanciate the class
my $hasPublicProtectedConstructor = 0;
# We need a public dtor to destroy the object --- ### aren't protected dtors ok too ??
my $hasPublicDestructor = 1; # by default all classes have a public dtor!
#my $hasVirtualDestructor = 0;
my $hasDestructor = 0;
my $hasPrivatePureVirtual = 0;
my $hasCopyConstructor = 0;
my $hasPrivateCopyConstructor = 0;
# Note: no need for hasPureVirtuals. $classNode{Pure} has that.
my $doPrivate = $main::doPrivate;
$main::doPrivate = 1;
# Look at each class member (looking for methods and enums in particular)
Iter::MembersByType ( $classNode, undef,
sub {
my( $classNode, $m ) = @_;
my $name = $m->{astNodeName};
if( $m->{NodeType} eq "method" ) {
if ( $m->{ReturnType} eq 'typedef' # TQFile's EncoderFn/DecoderFn callback, very badly parsed
) {
$m->{NodeType} = 'deleted';
next;
}
print STDERR "preParseClass: looking at $className\::$name $m->{Params}\n" if ($debug);
if ( $name eq $classNode->{astNodeName} ) {
if ( $m->{ReturnType} =~ /~/ ) {
# A destructor
$hasPublicDestructor = 0 if $m->{Access} ne 'public';
#$hasVirtualDestructor = 1 if ( $m->{Flags} =~ "v" && $m->{Access} ne 'private' );
$hasDestructor = 1;
} else {
# A constructor
$constructorCount++;
$defaultConstructor = $m->{Access} if ( $m->{Params} eq '' );
$hasPublicProtectedConstructor = 1 if ( $m->{Access} ne 'private' );
# Copy constructor?
if ( $#{$m->{ParamList}} == 0 ) {
my $theArgType = @{$m->{ParamList}}[0]->{ArgType};
if ($theArgType =~ /$className\s*\&/) {
$hasCopyConstructor = 1;
$hasPrivateCopyConstructor = 1 if ( $m->{Access} eq 'private' );
}
}
# Hack the return type for constructors, since constructors return an object pointer
$m->{ReturnType} = $className."*";
}
}
if ( $name =~ /~$classNode->{astNodeName}/ && $m->{Access} ne "private" ) { # not used
$hasPublicDestructor = 0 if $m->{Access} ne 'public';
#$hasVirtualDestructor = 1 if ( $m->{Flags} =~ "v" );
$hasDestructor = 1;
}
if ( $m->{Flags} =~ "p" && $m->{Access} =~ /private/ ) {
$hasPrivatePureVirtual = 1; # ouch, can't inherit from that one
}
# All we want from private methods is to check for virtuals, nothing else
next if ( $m->{Access} =~ /private/ );
# Don't generate code for deprecated methods,
# or where the code won't compile/link for obscure reasons. Or even obvious reasons..
if ( ($classNode->{astNodeName} eq 'KCharSelectTable' and $name eq 'paintCell')
|| ($classNode->{astNodeName} eq 'KAnimWidget' and $name eq 'KAnimWidget' and @{$m->{ParamList}} == 2)
|| ($classNode->{astNodeName} eq 'KDCOPActionProxy' and $name eq 'actions')
|| ($classNode->{astNodeName} eq 'KFileDialog' and $name eq 'addDirEntry')
|| ($classNode->{astNodeName} eq 'KFileDialog' and $name eq 'getDirEntry')
|| ($classNode->{astNodeName} eq 'KFileView' and $name eq 'selectionMode')
|| ($classNode->{astNodeName} eq 'KFind' and $name eq 'KFind' and @{$m->{ParamList}} == 4)
|| ($classNode->{astNodeName} eq 'KGlobalAccel' and $name eq 'setEnabled')
|| ($classNode->{astNodeName} eq 'KCharsets' and $name eq 'encodingsForLanguage')
|| ($classNode->{astNodeName} eq 'KInputDialog' and $name eq 'getInteger')
|| ($classNode->{astNodeName} eq 'KIO' and $name eq 'buildHTMLErrorString')
|| ($classNode->{astNodeName} eq 'SlaveBase' and $name eq 'checkCachedAuthentication')
|| ($classNode->{astNodeName} eq 'SlaveBase' and $name eq 'cacheAuthentication')
|| ($classNode->{astNodeName} eq 'KInputDialog' and $name eq 'getDouble')
|| ($classNode->{astNodeName} eq 'KToolBar' and $name eq 'enable')
|| ($classNode->{astNodeName} eq 'KAccel' and $name eq 'insert' and @{$m->{ParamList}} == 2)
|| ($classNode->{astNodeName} eq 'KAccel' and $name eq 'autoupdate')
|| ($classNode->{astNodeName} eq 'KAccel' and $name eq 'getAutoUpdate')
|| ($classNode->{astNodeName} eq 'KStdAccel' and $name eq 'insert')
|| ($classNode->{astNodeName} eq 'KBookmarkMenu' and $name eq 'invalid')
|| ($classNode->{astNodeName} eq 'KCharsets' and $name eq 'languages')
|| ($classNode->{astNodeName} eq 'KCombiView' and $name eq 'setDropOptions')
|| ($classNode->{astNodeName} eq 'KFileMetaInfoItem' and $name eq 'unit')
|| ($classNode->{astNodeName} eq 'KInstance' and $name eq 'charsets')
|| ($classNode->{astNodeName} eq 'KInstance' and $name eq 'KInstance' and $m->{Access} =~ /protected/)
|| ($classNode->{astNodeName} eq 'KKey' and $name eq 'isValidQt')
|| ($classNode->{astNodeName} eq 'KKey' and $name eq 'isValidNative')
|| ($classNode->{astNodeName} eq 'KKeySequence' and $name eq 'init')
|| ($classNode->{astNodeName} eq 'KKeySequence' and $name eq 'setTriggerOnRelease')
|| ($classNode->{astNodeName} eq 'KEMailSettings' and $name eq 'getExtendedSetting')
|| ($classNode->{astNodeName} eq 'KEMailSettings' and $name eq 'setExtendedSetting')
|| ($classNode->{astNodeName} eq 'KProtocolManager' and $name eq 'defaultConnectTimeout')
|| ($classNode->{astNodeName} eq 'KMD5' and $name eq 'transform')
|| ($classNode->{astNodeName} eq 'KSSLCertificate' and $name eq 'operator!=')
|| ($classNode->{astNodeName} eq 'KSSLPKCS7' and $name eq 'validate')
|| ($classNode->{astNodeName} eq 'KSSLPKCS7' and $name eq 'revalidate')
|| ($classNode->{astNodeName} eq 'KSSLSession' and $name eq 'KSSLSession' and @{$m->{ParamList}} == 1)
|| ($classNode->{astNodeName} eq 'KSimpleFileFilter' and $name eq 'nameFilters')
|| ($classNode->{astNodeName} eq 'KTabWidget' and $name eq 'isTabReorderingEnabled')
|| ($classNode->{astNodeName} eq 'KTabWidget' and $name eq 'hoverCloseButton')
|| ($classNode->{astNodeName} eq 'TQUriDrag' and $name =~ /^decode$|decodeLocalFiles|decodeToUnicodeUris/)
|| ($name eq 'virtual_hook')
|| ($name =~ /_KShared_/)
|| ($name eq 'qObject')
|| ($name =~ /argv/)
|| ($name =~ /argc/)
|| ($name eq 'qt_emit')
|| ($name eq 'qt_invoke')
|| ($name eq 'qt_cast')
|| ($name eq 'qt_property')
|| ($name eq 'staticMetaObject')
|| ($classNode->{astNodeName} eq 'KTar' and $name eq 'writeFile_impl')
# Assume only Qt classes have tr() and trUtf8() in their Q_OBJECT macro
|| ($classNode->{astNodeName} !~ /^Q/ and $name eq 'tr')
|| ($classNode->{astNodeName} !~ /^Q/ and $name eq 'trUtf8')
|| $m->{Deprecated} ) {
$m->{NodeType} = 'deleted';
next;
}
my $argId = 0;
my $firstDefaultParam;
foreach my $arg ( @{$m->{ParamList}} ) {
# Look for first param with a default value
if ( defined $arg->{DefaultValue} && !defined $firstDefaultParam ) {
$firstDefaultParam = $argId;
}
if ( $arg->{ArgType} eq '...' # refuse a method with variable arguments
or $arg->{ArgType} eq 'image_io_handler' # TQImage's callback
or $arg->{ArgType} eq 'DecoderFn' # TQFile's callback
or $arg->{ArgType} eq 'EncoderFn' # TQFile's callback
or $arg->{ArgType} =~ /bool \(\*\)\(TQObject/ # TQMetaObject's ctor
or $arg->{ArgType} eq 'QtStaticMetaObjectFunction' # TQMetaObjectCleanUp's ctor with func pointer
or $arg->{ArgType} eq 'const TQTextItem&' # ref to a private class in 3.2.0b1
or $arg->{ArgType} eq 'FILE*' # won't be able to handle that I think
or $arg->{ArgType} eq 'const KKeyNative&' #
) {
$m->{NodeType} = 'deleted';
}
else
{
# Resolve type in full, e.g. for TQSessionManager::RestartHint
# (TQSessionManagerJBridge doesn't inherit TQSessionManager)
$arg->{ArgType} = kalyptusDataDict::resolveType($arg->{ArgType}, $classNode, $rootnode);
registerType( $arg->{ArgType} );
$argId++;
}
}
$m->AddProp( "FirstDefaultParam", $firstDefaultParam );
$m->{ReturnType} = kalyptusDataDict::resolveType($m->{ReturnType}, $classNode, $rootnode) if ($m->{ReturnType});
registerType( $m->{ReturnType} );
}
elsif( $m->{NodeType} eq "enum" ) {
if ( ! $m->{astNodeName} ) {
$m->{Access} = 'protected';
}
my $fullEnumName = $className."::".$m->{astNodeName};
if ( ($fullEnumName eq 'KMimeType::Format' and $name eq 'compression')
|| $m->{Deprecated} ) {
$m->{NodeType} = 'deleted';
next;
}
$classNode->{enumerations}{$m->{astNodeName}} = $fullEnumName;
# if $m->{astNodeName} and $m->{Access} ne 'private';
# if $m->{astNodeName} ;
# Define a type for this enum
registerType( $fullEnumName );
# Remember that it's an enum
findTypeEntry( $fullEnumName )->{isEnum} = 1;
}
elsif( $m->{NodeType} eq 'var' ) {
my $varType = $m->{Type};
# We are interested in public static vars, like TQColor::blue
if ( $varType =~ s/static\s+// && $m->{Access} ne 'private'
&& $className."::".$m->{astNodeName} ne "KSpell::modalListText" )
{
$varType =~ s/const\s+(.*)\s*&/$1/;
$varType =~ s/\s*$//;
print STDERR "var: $m->{astNodeName} '$varType'\n" if ($debug);
# Register the type
registerType( $varType );
} else {
# To avoid duplicating the above test, we just get rid of any other var
$m->{NodeType} = 'deleted';
}
}
},
undef
);
$main::doPrivate = $doPrivate;
print STDERR "$className: ctor count: $constructorCount, hasPublicProtectedConstructor: $hasPublicProtectedConstructor, hasCopyConstructor: $hasCopyConstructor:, defaultConstructor: $defaultConstructor, hasPublicDestructor: $hasPublicDestructor, hasPrivatePureVirtual:$hasPrivatePureVirtual\n" if ($debug);
# Note that if the class has _no_ constructor, the default ctor applies. Let's even generate it.
if ( !$constructorCount && $defaultConstructor eq 'none' && !$hasPrivatePureVirtual ) {
# Create a method node for the constructor
my $methodNode = Ast::New( $classNode->{astNodeName} );
$methodNode->AddProp( "NodeType", "method" );
$methodNode->AddProp( "Flags", "" );
$methodNode->AddProp( "Params", "" );
$methodNode->AddProp( "ParamList", [] );
kdocAstUtil::attachChild( $classNode, $methodNode );
# Hack the return type for constructors, since constructors return an object pointer
$methodNode->AddProp( "ReturnType", $className."*" );
registerType( $className."*" );
$methodNode->AddProp( "Access", "public" ); # after attachChild
$defaultConstructor = 'public';
$hasPublicProtectedConstructor = 1;
}
# Also, if the class has no explicit destructor, generate a default one.
if ( !$hasDestructor && !$hasPrivatePureVirtual ) {
my $methodNode = Ast::New( "$classNode->{astNodeName}" );
$methodNode->AddProp( "NodeType", "method" );
$methodNode->AddProp( "Flags", "" );
$methodNode->AddProp( "Params", "" );
$methodNode->AddProp( "ParamList", [] );
kdocAstUtil::attachChild( $classNode, $methodNode );
$methodNode->AddProp( "ReturnType", "~" );
$methodNode->AddProp( "Access", "public" );
}
# If we have a private pure virtual, then the class can't be instanciated (e.g. TQCanvasItem)
# Same if the class has only private constructors (e.g. TQInputDialog)
$classNode->AddProp( "CanBeInstanciated", $hasPublicProtectedConstructor
# && !$hasPrivatePureVirtual
&& (!$classNode->{Pure} or $classNode->{astNodeName} eq 'TQValidator')
&& !($classNode->{NodeType} eq 'namespace')
&& ($classNode->{astNodeName} !~ /^DrawContentsEvent$|^MouseEvent$|^MouseDoubleClickEvent$|^MouseMoveEvent$|^MouseReleaseEvent$|^MousePressEvent$/)
&& ($classNode->{astNodeName} !~ /TQMetaObject|TQDragObject|Slave|CopyJob|KMdiChildFrm|KNamedCommand/) );
# We will derive from the class only if it has public or protected constructors.
# (_Even_ if it has pure virtuals. But in that case the *.cpp class can't be instantiated either.)
$classNode->AddProp( "BindingDerives", $hasPublicProtectedConstructor );
# We need a public dtor to destroy the object --- ### aren't protected dtors ok too ??
$classNode->AddProp( "HasPublicDestructor", $hasPublicDestructor );
# Hack for TQAsyncIO. We don't implement the "if a class has no explicit copy ctor,
# then all of its member variables must be copiable, otherwise the class isn't copiable".
$hasPrivateCopyConstructor = 1 if ( $className eq 'TQAsyncIO' );
# Remember if this class can't be copied - it means all its descendants can't either
$classNode->AddProp( "CanBeCopied", !$hasPrivateCopyConstructor );
$classNode->AddProp( "HasCopyConstructor", $hasCopyConstructor );
}
sub propagateCanBeCopied($)
{
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
my @super = superclass_list($classNode);
# A class can only be copied if none of its ancestors have a private copy ctor.
for my $s (@super) {
if (!$s->{CanBeCopied}) {
$classNode->{CanBeCopied} = 0;
print STDERR "$classNode->{astNodeName} cannot be copied\n" if ($debug);
last;
}
}
# If the class has no explicit copy constructor, and it can be copied,
# generate the copy constructor.
if ( !$classNode->{HasCopyConstructor} && $classNode->{CanBeCopied} && $classNode->{CanBeInstanciated} ) {
my $methodNode = Ast::New( "$classNode->{astNodeName}" );
$methodNode->AddProp( "NodeType", "method" );
$methodNode->AddProp( "Flags", "" );
my $argType = "const ".$className."&";
registerType( $argType );
$methodNode->AddProp( "Params", $argType );
# The param node
my $node = Ast::New( 1 ); # let's make the arg index the node "name"
$node->AddProp( "NodeType", "param" );
$node->AddProp( "ArgType", $argType );
$methodNode->AddPropList( "ParamList", $node );
kdocAstUtil::attachChild( $classNode, $methodNode );
# Hack the return type for constructors, since constructors return an object pointer
$methodNode->AddProp( "ReturnType", $className."*" );
registerType( $className."*" );
$methodNode->AddProp( "Access", "public" ); # after attachChild
}
# Prepare the {case} dict for the class
prepareCaseDict( $classNode );
}
=head2 writeClassDoc
Called by writeDoc for each class to be written out
=cut
sub writeClassDoc
{
my( $node ) = @_;
my $className = join( "::", kdocAstUtil::heritage($node) );
my $javaClassName = $node->{astNodeName};
# Makefile doesn't like '::' in filenames, so use __
my $fileName = $node->{astNodeName};
# my $fileName = join( "__", kdocAstUtil::heritage($node) );
print "Enter: $className\n" if $debug;
my $typeprefix = ($className =~ /^Q/ ? "qt_" : "kde_");
my $packagename = ($typeprefix eq 'qt_' ? "org.kde.qt" : "org.kde.koala");
# Write out the *.java file
my $classFile = "$outputdir/$fileName.java";
open( CLASS, ">$classFile" ) || die "Couldn't create $classFile\n";
print STDERR "Writing $fileName.java\n" if ($debug);
print CLASS "//Auto-generated by $0. DO NOT EDIT.\n";
print CLASS "package $packagename;\n\n";
print CLASS "import java.lang.reflect.Proxy;\n";
print CLASS "import org.kde.qt.SmokeInvocation;\n";
my %javaMethods = ();
my %addImport = ();
my @ancestors = ();
my @ancestor_nodes = ();
Iter::Ancestors( $node, $rootnode, undef, undef, sub {
my ( $ances, $name, $type, $template ) = @_;
if ( $name ne "TQMemArray" and $name ne "TQSqlFieldInfoList" ) {
push @ancestor_nodes, $ances;
push @ancestors, $name;
}
},
undef
);
my ($methodCode, $interfaceCode, $proxyInterfaceCode, $signalCode) = generateAllMethods( $node, $#ancestors + 1,
\%javaMethods,
$node,
1,
\%addImport );
my $signalFile = "$outputdir/$fileName" . "Signals.java";
if ( $signalCode ne '' ) {
open( SIGNALS, ">$signalFile" ) || die "Couldn't create $signalFile\n";
print SIGNALS "//Auto-generated by $0. DO NOT EDIT.\n";
print SIGNALS "package $packagename;\n\n";
}
my $tempMethodNumber = $methodNumber;
# Add method calls for the interfaces implemented by the class
foreach my $ancestor_node ( @ancestor_nodes ) {
if ( kalyptusDataDict::interfacemap($ancestor_node->{astNodeName}) ne () && ($#ancestors > 0) ) {
my ($meth, $interf, $proxyInterf, $sig) = generateAllMethods( $ancestor_node, 0, \%javaMethods, $node, 0, \%addImport );
$methodCode .= $meth;
$interfaceCode .= $interf;
$proxyInterfaceCode .= $proxyInterf;
}
}
if ( $className eq 'Qt' or $className eq 'KDE' ) {
my $globalSpace = kdocAstUtil::findRef( $rootnode, $main::globalSpaceClassName );
my ($meth, $interf, $proxyInterf, $sig) = generateAllMethods( $globalSpace, 0, \%javaMethods, $node, 0, \%addImport );
$methodCode .= $meth;
$interfaceCode .= $interf;
$proxyInterfaceCode .= $proxyInterf;
}
$methodNumber = $tempMethodNumber;
if ( $className eq 'Qt' ) {
print CLASS "import java.io.*;\n";
print CLASS "import java.text.MessageFormat;\n";
print CLASS "import java.lang.reflect.*;\n";
} else {
if ( $className eq 'TQListView' or $className eq 'TQListViewItem' or $className eq 'TQUriDrag' ) {
# Special case these two classes as they have methods that use ArrayList added as 'extras'
print CLASS "import java.util.ArrayList;\n";
}
print CLASS "import org.kde.qt.Qt;\n";
}
if ( kalyptusDataDict::interfacemap($javaClassName) ne () ) {
my $interfaceFile = "$outputdir/" . kalyptusDataDict::interfacemap($javaClassName) . ".java";
open( INTERFACE, ">$interfaceFile" ) || die "Couldn't create $interfaceFile\n";
print INTERFACE "//Auto-generated by $0. DO NOT EDIT.\n";
print INTERFACE "package $packagename;\n\n";
}
foreach my $imp (keys %addImport) {
die if $imp eq '';
# Ignore any imports for classes in the same package as the current class
if ($imp !~ /$packagename/) {
print CLASS "import $imp;\n";
print INTERFACE "import $imp;\n";
print SIGNALS "import $imp;\n" unless $signalCode eq '';;
}
}
if ( kalyptusDataDict::interfacemap($javaClassName) ne () ) {
print INTERFACE "\npublic interface " . kalyptusDataDict::interfacemap($javaClassName) . " {\n";
print INTERFACE $interfaceCode;
print INTERFACE "}\n";
close INTERFACE;
}
my $classdec;
if ($node->{NodeType} eq 'namespace') {
$classdec = "public class $javaClassName {\n";
$classdec .= "\tprotected Object _proxy = null;\n";
} elsif ( $#ancestors < 0 ) {
$classdec = "public class $javaClassName implements QtSupport";
if ( kalyptusDataDict::interfacemap($javaClassName) ne () ) {
$classdec .= ", " . kalyptusDataDict::interfacemap($javaClassName);
}
$classdec .= " {\n\tprotected Object _proxy = null;\n";
} else {
$classdec = "public class $javaClassName extends ";
my $ancestor;
foreach $ancestor ( @ancestors ) {
if ( kalyptusDataDict::interfacemap($ancestor) eq () or $ancestor eq @ancestors[$#ancestors] ) {
$ancestor =~ s/^.*:://;
$classdec .= "$ancestor ";
if ( $typeprefix ne 'qt_' and $ancestor =~ /^Q/ ) {
print CLASS "import org.kde.qt.$ancestor;\n";
}
last;
}
}
my @implements = ();
if ( $#ancestors >= 1 ) {
foreach $ancestor ( @ancestors ) {
if ( kalyptusDataDict::interfacemap($ancestor) ne () ) {
push(@implements, kalyptusDataDict::interfacemap($ancestor));
}
}
}
if ($#implements >= 0) {
$classdec .= "implements ";
$classdec .= join(", ", @implements);
}
$classdec .= " {\n";
}
print CLASS "\n";
if ( $javaClassName !~ /^Q/ or $signalCode ne '' ) {
my $signalLink = '';
if ( $signalCode ne '' ) {
print SIGNALS "\npublic interface $javaClassName" . "Signals {\n";
print SIGNALS $signalCode;
print SIGNALS "}\n";
close SIGNALS;
$signalLink = " See {\@link $javaClassName" . "Signals} for signals emitted by $javaClassName\n";
}
my $docnode = $node->{DocNode};
print CLASS "/**\n";
if ( defined $docnode ) {
print CLASS printJavadocComment( $docnode, "", "", $signalLink ) . "\n"
} else {
print CLASS $signalLink;
}
print CLASS "*/\n";
}
print CLASS $classdec;
print CLASS "\tinterface $javaClassName" . "ProxyInterface {\n";
print CLASS $proxyInterfaceCode;
print CLASS "\t}\n\n";
if ( $#ancestors < 0 ) {
print CLASS "\tprotected ", $javaClassName, "(Class[] interfaces, int index) {\n";
print CLASS "\t\tinterfaces[index] = $javaClassName" . "ProxyInterface.class;\n";
print CLASS "\t\t_proxy = Proxy.newProxyInstance(";
print CLASS "$javaClassName.class.getClassLoader(),\n";
print CLASS "\t\t\tinterfaces,\n\t\t\tnew SmokeInvocation(this) );\n\t}\n";
} else {
print CLASS "\tprivate static Class[] addInterfaces(Class[] interfaces, int index) {\n";
print CLASS "\t\tinterfaces[index] = $javaClassName" . "ProxyInterface.class;\n";
print CLASS "\t\treturn interfaces;\n\t}\n";
print CLASS "\tprotected ", $javaClassName, "(Class[] interfaces, int index) {\n";
print CLASS "\t\tsuper(addInterfaces(interfaces, index), index+1);\n\t}\n";
}
print CLASS $methodCode;
if ( $className eq 'Qt' ) {
print CLASS $qtExtras;
} elsif ( $className eq 'TQApplication' ) {
print CLASS $qapplicationExtras;
} elsif ( $className eq 'TQBitmap' ) {
print CLASS $qbitmapExtras;
} elsif ( $className eq 'TQDropEvent' ) {
print CLASS $qdropeventExtras;
} elsif ( $className eq 'TQDragObject' ) {
print CLASS $qdragobjectExtras;
} elsif ( $className eq 'TQObject' ) {
print CLASS $qobjectExtras;
} elsif ( $className eq 'TQListView' ) {
print CLASS $qlistviewExtras;
} elsif ( $className eq 'TQListViewItem' ) {
print CLASS $qlistviewitemExtras;
} elsif ( $className eq 'TQMimeSource' ) {
print CLASS $qmimesourceExtras;
} elsif ( $className eq 'TQWidget' ) {
print CLASS $qwidgetExtras;
} elsif ( $className eq 'TQPaintDevice' ) {
print CLASS $qpaintdeviceExtras;
} elsif ( $className eq 'TQPixmap' ) {
print CLASS $qpixmapExtras;
} elsif ( $className eq 'TQIODevice' ) {
print CLASS $qiodeviceExtras;
} elsif ( $className eq 'TQPointArray' ) {
print CLASS $qpointarrayExtras;
} elsif ( $className eq 'TQUriDrag' ) {
print CLASS $quridragExtras;
} elsif ( $className eq 'KApplication' ) {
print CLASS $kapplicationExtras;
} elsif ( $className eq 'KMainWindow' ) {
print CLASS $kmainwindowExtras;
}
print CLASS "}\n";
close CLASS;
}
# Generate the prototypes for a method (one per arg with a default value)
# Helper for makeprotos
sub iterproto($$$$$) {
my $classidx = shift; # to check if a class exists
my $method = shift;
my $proto = shift;
my $idx = shift;
my $protolist = shift;
my $argcnt = scalar @{ $method->{ParamList} } - 1;
if($idx > $argcnt) {
push @$protolist, $proto;
return;
}
if(defined $method->{FirstDefaultParam} and $method->{FirstDefaultParam} <= $idx) {
push @$protolist, $proto;
}
my $arg = $method->{ParamList}[$idx]->{ArgType};
my $typeEntry = findTypeEntry( $arg );
my $realType = $typeEntry->{realType};
# A scalar ?
$arg =~ s/\bconst\b//g;
$arg =~ s/\s+//g;
if($typeEntry->{isEnum} || $allTypes{$realType}{isEnum} || exists $typeunion{$realType} || exists $mungedTypeMap{$arg})
{
my $id = '$'; # a 'scalar
$id = '?' if $arg =~ /[*&]{2}/;
$id = $mungedTypeMap{$arg} if exists $mungedTypeMap{$arg};
iterproto($classidx, $method, $proto . $id, $idx + 1, $protolist);
return;
}
# A class ?
if(exists $classidx->{$realType}) {
iterproto($classidx, $method, $proto . '#', $idx + 1, $protolist);
return;
}
# A non-scalar (reference to array or hash, undef)
iterproto($classidx, $method, $proto . '?', $idx + 1, $protolist);
return;
}
# Generate the prototypes for a method (one per arg with a default value)
sub makeprotos($$$) {
my $classidx = shift;
my $method = shift;
my $protolist = shift;
iterproto($classidx, $method, $method->{astNodeName}, 0, $protolist);
}
# Return the string containing the signature for this method (without return type).
# If the 2nd arg is not the size of $m->{ParamList}, this method returns a
# partial signature (this is used to handle default values).
sub methodSignature($$) {
my $method = shift;
my $last = shift;
my $sig = $method->{astNodeName};
my @argTypeList;
my $argId = 0;
foreach my $arg ( @{$method->{ParamList}} ) {
last if $argId > $last;
push @argTypeList, $arg->{ArgType};
$argId++;
}
$sig .= "(". join(", ",@argTypeList) .")";
$sig .= " const" if $method->{Flags} =~ "c";
return $sig;
}
# Return the string containing the java signature for this method (without return type).
# If the 2nd arg is not the size of $m->{ParamList}, this method returns a
# partial signature (this is used to handle default values).
sub javaMethodSignature($$) {
my $method = shift;
my $last = shift;
my $sig = $method->{astNodeName};
my @argTypeList;
my $argId = 0;
foreach my $arg ( @{$method->{ParamList}} ) {
$argId++;
last if $argId > $last;
push @argTypeList, "arg" . "$argId ". cplusplusToJava( $arg->{ArgType} );
}
$sig .= "(". join(", ",@argTypeList) .")";
return $sig;
}
sub coerce_type($$$$) {
#my $m = shift;
my $union = shift;
my $var = shift;
my $type = shift;
my $new = shift; # 1 if this is a return value, 0 for a normal param
my $typeEntry = findTypeEntry( $type );
my $realType = $typeEntry->{realType};
my $unionfield = $typeEntry->{typeId};
# die "$type" unless defined( $unionfield );
if ( ! defined( $unionfield ) ) {
print STDERR "type field not defined: $type\n";
return "";
}
$unionfield =~ s/t_/s_/;
$type =~ s/\s+const$//; # for 'char* const'
$type =~ s/\s+const\s*\*$/\*/; # for 'char* const*'
my $code = "$union.$unionfield = ";
if($type =~ /&$/) {
$code .= "(void*)&$var;\n";
} elsif($type =~ /\*$/) {
$code .= "(void*)$var;\n";
} else {
if ( $unionfield eq 's_class'
or ( $unionfield eq 's_voidp' and $type ne 'void*' )
or $type eq 'TQString' ) { # hack
$type =~ s/^const\s+//;
if($new) {
$code .= "(void*)new $type($var);\n";
} else {
$code .= "(void*)&$var;\n";
}
} else {
$code .= "$var;\n";
}
}
return $code;
}
# Generate the list of args casted to their real type, e.g.
# (TQObject*)x[1].s_class,(TQEvent*)x[2].s_class,x[3].s_int
sub makeCastedArgList
{
my @castedList;
my $i = 1; # The args start at x[1]. x[0] is the return value
my $arg;
foreach $arg (@_) {
my $type = $arg;
my $cast;
my $typeEntry = findTypeEntry( $type );
my $unionfield = $typeEntry->{typeId};
# die "$type" unless defined( $unionfield );
if ( ! defined( $unionfield ) ) {
print STDERR "type field not defined: $type\n";
return "";
}
$unionfield =~ s/t_/s_/;
$type =~ s/\s+const$//; # for 'char* const'
$type =~ s/\s+const\s*\*$/\*/; # for 'char* const*'
my $v .= " arg$i";
if($type =~ /&$/) {
$cast = "*($type *)";
} elsif($type =~ /\*$/) {
$cast = "($type)";
} elsif($type =~ /\(\*\)\s*\(/) { # function pointer ... (*)(...)
$cast = "($type)";
} else {
if ( $unionfield eq 's_class'
or ( $unionfield eq 's_voidp' and $type ne 'void*' )
or $type eq 'TQString' ) { # hack
$cast = "*($type *)";
} else {
$cast = "($type)";
}
}
push @castedList, "$type$v";
$i++;
}
return @castedList;
}
# Adds the import for node $1 to be imported in $2 if not already there
# Prints out debug stuff if $3
sub addImportForClass($$$)
{
my ( $node, $addImport, $debugMe ) = @_;
my $importname = javaImport( $node->{astNodeName} );
# print " Importing $importname for node name: " . $node->{astNodeName} . "\n";
# No import needed, so return
return if ( $importname eq '' );
unless ( defined $addImport->{$importname} ) {
print " Importing $importname\n" if ($debugMe);
$addImport->{$importname} = 1;
if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ) {
$addImport->{$importname . "Interface"} = 1;
}
}
else { print " $importname already imported.\n" if ($debugMe); }
}
sub checkImportsForObject($$)
{
my $type = shift;
my $addImport = shift;
my $debugCI = 0; #$debug
# print "checkImportsForObject $type\n";
$type =~ s/const\s+//;
my $it = $type;
if (!($it and exists $typeunion{$it}) and $type ne ""
#and $type !~ /&/ # in fact we also want refs, due to the generated code
) {
$type =~ s/&//;
$type =~ s/[*]//;
print " Detecting an object by value/ref: $type\n" if ($debugCI);
my $node = kdocAstUtil::findRef( $rootnode, $type );
if ($node and $node->{NodeType} eq "class" ) {
print " NodeType: " . $node->{NodeType} . "\n" if ($debugCI);
addImportForClass( $node, $addImport, $debugCI );
}
else {
if ( cplusplusToJava($it) eq 'ArrayList' ) {
$addImport->{"java.util.ArrayList"} = 1;
} else {
print " No import found for $type\n" if ($debugCI);
}
}
}
}
sub generateVirtualMethod($$$$$)
{
# Generating methods for $class.
# $m: method node. $methodClass: the node of the class in which the method is really declared
# (can be different from $class when the method comes from a super class)
# This is important because of $allMethods, which has no entry for class::method in that case.
my( $classNode, $signature, $m, $methodClass, $addImport ) = @_;
my $methodCode = ''; # output
my $returnType = $m->{ReturnType};
return ('', '') if $returnType eq '~'; # skip destructors
my $className = $classNode->{astNodeName};
my $flags = $m->{Flags};
my @argList = @{$m->{ParamList}};
print "generateVirtualMethod $className: $signature ($m->{Access})\n" if ($debug);
# Detect objects returned by value
checkImportsForObject( $returnType, $addImport ) if ($returnType ne 'void');
# Generate a matching virtual method in the x_ class
$methodCode .= "\tvirtual $returnType $m->{astNodeName}(";
my $i = 0;
foreach my $arg ( @argList ) {
$methodCode .= ", " if $i++;
$methodCode .= $arg->{ArgType};
$methodCode .= " x$i";
# Detect objects passed by value
checkImportsForObject( $arg->{ArgType}, $addImport );
}
$methodCode .= ") ";
$methodCode .= "const " if ($flags =~ "c");
$methodCode .= "\{\n";
# Now the code of the method
my $this = $classNode->{BindingDerives} > 0 ? "this" : "xthis";
$i++; # Now the number of args
$methodCode .= "\tSmoke::StackItem x[$i];\n";
$i = 1;
for my $arg (@argList) {
$methodCode .= "\t";
$methodCode .= coerce_type("x[$i]", "x$i", $arg->{ArgType}, 0);
$i++;
}
my $sig = $methodClass->{astNodeName} . "::" . $signature;
my $idx = $allMethods{$sig};
# die "generateVirtualMethod: $className: No method found for $sig\n" if !defined $idx;
if ( !defined $idx ) {
print STDERR "generateVirtualMethod: $className: No method found for $sig\n";
return "";
}
if($flags =~ "p") { # pure virtual
$methodCode .= "\t${libname}_Smoke->binding->callMethod($idx, (void*)$this, x, true /*pure virtual*/);\n";
} else {
$methodCode .= "\tif(${libname}_Smoke->binding->callMethod($idx, (void*)$this, x)) ";
}
$returnType = undef if ($returnType eq 'void');
if($returnType) {
my $arg = $returnType;
my $it = $arg;
my $cast;
my $v = "x[0]";
my $indent = ($flags =~ "p") ? "\t" : "";
if($it and exists $typeunion{$it}) {
$v .= ".$typeunion{$it}";
$cast = "($arg)";
$methodCode .= "${indent}return $cast$v;\n";
} else {
$v .= ".s_class";
if($arg =~ s/&//) {
$cast = "*($arg *)";
$methodCode .= "${indent}return $cast$v;\n";
} elsif($arg !~ /\*/) {
unless($flags =~ "p") {
$indent = "\t ";
$methodCode .= "{\n";
}
# we assume it's a new thing, and handle it
$methodCode .= "${indent}$arg *xptr = ($arg *)$v;\n";
$methodCode .= "${indent}$arg xret(*xptr);\n";
$methodCode .= "${indent}delete xptr;\n";
$methodCode .= "${indent}return xret;\n";
$methodCode .= "\t}\n" unless $flags =~ "p";
} else {
$cast = "($arg)";
$methodCode .= "${indent}return $cast$v;\n";
}
}
} else {
$methodCode .= "\t" if $flags =~ "p";
$methodCode .= "return;\n";
}
if($flags =~ "p") {
$methodCode .= "\t// ABSTRACT\n";
$methodCode .= " }\n";
return ( $methodCode );
}
$methodCode .= "\t";
if($returnType) {
$methodCode .= "return ";
}
$methodCode .= "$this\->$methodClass->{astNodeName}\::$m->{astNodeName}(";
$i = 0;
for my $arg (@argList) {
$methodCode .= ", " if $i++;
$methodCode .= "x$i";
}
$methodCode .= ");\n";
$methodCode .= "\t}\n";
return ( $methodCode );
}
sub generateMethod($$$$$$$)
{
my( $classNode, $m, $addImport, $ancestorCount, $javaMethods, $mainClassNode, $generateConstructors ) = @_; # input
my $methodCode = ''; # output
my $interfaceCode = ''; # output
my $proxyInterfaceCode = ''; # output
my $signalCode = ''; # output
my $name = $m->{astNodeName}; # method name
my @heritage = kdocAstUtil::heritage($classNode);
my $className = join( "::", @heritage );
@heritage = kdocAstUtil::heritage($mainClassNode);
my $mainClassName = join( "::", @heritage );
# The javaClassName might be 'TQWidget', while currentClassName is 'TQRangeControl'
# and the TQRangeControl methods are being copied into TQWidget.
my $javaClassName = $mainClassNode->{astNodeName};
my $currentClassName = $classNode->{astNodeName};
my $firstUnknownArgType = 99;
my $returnType = $m->{ReturnType};
# Don't use $className here, it's never the fully qualified (A::B) name for a ctor.
my $isConstructor = ($name eq $classNode->{astNodeName} );
my $isDestructor = ($returnType eq '~');
# Don't generate anything for destructors, or constructors for namespaces
return if $isDestructor
or ($classNode->{NodeType} eq 'namespace' and $isConstructor)
or (!$mainClassNode->{CanBeInstanciated} and $m->{Access} =~ /protected/);
# Rename operator methods 'op_...'
if ( $name =~ /^operator.*/ ) {
$methodNumber++;
$name =~ s/ //;
if (! exists $operatorNames{$name} ) {
return;
}
$name = $operatorNames{$name};
}
if ($classNode->{astNodeName} eq $main::globalSpaceClassName) {
my $sourcename = $m->{Source}->{astNodeName};
# Only put Global methods which came from sources beginning with q into class Qt
if ($javaClassName eq 'Qt' and ( $sourcename !~ /\/q[^\/]*$/ or $sourcename =~ /string.h$/ )) {
return;
}
# ..and any other global methods into KDE
if ($javaClassName eq 'KDE' and $m->{Source}->{astNodeName} =~ /\/q[^\/]*$/) {
return;
}
if ( $sourcename !~ s!.*(kio/|kparts/|dom/|kabc/|ksettings/|kjs/|ktexteditor/|tdeprint/|tdesu/)(.*)!$1$2!m ) {
$sourcename =~ s!.*/(.*)!$1!m;
}
if ( $sourcename eq '' ) {
return;
}
}
if ($returnType eq 'void') {
$returnType = undef;
} else {
# Detect objects returned by value
checkImportsForObject( $returnType, $addImport );
}
my $hasDuplicateSignature = 0;
my $isStatic = $m->{Flags} =~ "s";
my $isPure = $m->{Flags} =~ "p";
return if ( $m->{SkipFromSwitch} && $m->{Flags} !~ "p" );
# # Skip internal methods, which return unknown types
# # Hmm, the C# bindings have a list of those too.
# return if ( $returnType =~ m/TQGfx\s*\*/ );
# return if ( $returnType eq 'CGContextRef' );
# return if ( $returnType eq 'TQWSDisplay *' );
# # This stuff needs callback, or **
# return if ( $name eq 'defineIOHandler' or $name eq 'qt_init_internal' );
# # Skip casting operators, but not == < etc.
# return if ( $name =~ /operator \w+/ );
# # TQFile's EncoderFn/DecoderFn
# return if ( $name =~ /set[ED][ne]codingFunction/ );
# # How to implement this? (TQXmlDefaultHandler/TQXmlEntityResolver::resolveEntity, needs A*&)
# return if ( $name eq 'resolveEntity' and $className =~ /^TQXml/ );
# return if ( $className eq 'TQBitArray' && $m->{Access} eq 'protected' );
#print STDERR "Tests passed, generating.\n";
my $argId = 0;
my @argTypeList=();
my @javaArgTypeList=();
my @javaArgList = ();
my @namedArgTypeList=();
foreach my $arg ( @{$m->{ParamList}} ) {
$argId++;
if ( $arg->{ArgName} =~ /^super$|^int$|^env$|^cls$|^obj$|^byte$/ ) {
$arg->{ArgName} = "";
}
if ( $arg->{ArgName} =~ /^short$|^long$/ ) {
# Oops looks like a parser error
$arg->{ArgType} = $arg->{ArgName};
$arg->{ArgName} = "";
}
print STDERR " Param ".$arg->{astNodeName}." type: ".$arg->{ArgType}." name:".$arg->{ArgName}." default: ".$arg->{DefaultValue}." java: ".cplusplusToJava($arg->{ArgType})."\n" if ($debug);
my $argType = $arg->{ArgType};
my $namedArgType;
my $javaArgType;
my $javaArg;
my $argName;
if ( cplusplusToJava($argType) eq "" && $firstUnknownArgType > $argId ) {
$firstUnknownArgType = $argId;
}
$javaArg = ($arg->{ArgName} eq "" ? "arg" . $argId : $arg->{ArgName});
$namedArgType = $argType . " " . $javaArg;
$javaArgType = cplusplusToJava($argType) . " " . $javaArg;
push @argTypeList, $argType;
push @javaArgTypeList, $javaArgType;
push @javaArgList, $javaArg;
push @namedArgTypeList, $namedArgType;
# Detect objects passed by value
checkImportsForObject( $argType, $addImport );
}
if ( $name eq 'TQApplication' or ($javaClassName eq 'KCmdLineArgs' and $name eq 'init' and scalar(@javaArgList) > 1) ) {
# Junk the 'int argc' parameter
shift @javaArgTypeList;
shift @javaArgList;
}
my @castedArgList = makeCastedArgList( @argTypeList );
# We iterate as many times as we have default params
my $firstDefaultParam = $m->{FirstDefaultParam};
$firstDefaultParam = scalar(@argTypeList) unless defined $firstDefaultParam;
my $iterationCount = scalar(@argTypeList) - $firstDefaultParam;
my $javaReturnType = cplusplusToJava($m->{ReturnType});
if ( $javaReturnType =~ s/StringBuffer/String/ ) {
;
} elsif ( $javaReturnType =~ s/String\[\]/ArrayList/ ) {
$addImport->{"java.util.ArrayList"} = 1;
}
if ($m->{ReturnType} =~ /^int\&/) {
$javaReturnType = 'int';
}
if ($javaReturnType eq "") {
$firstUnknownArgType = 0;
}
print STDERR " ". ($iterationCount+1). " iterations for $name\n" if ($debug);
my $javaSignature = javaMethodSignature( $m, @argTypeList );
if ( defined $javaMethods->{$javaSignature} ) {
$hasDuplicateSignature = 1;
}
my $docnode = $m->{DocNode};
if ( $firstUnknownArgType >= 0 && $m->{Access} !~ /signals/ && ! $hasDuplicateSignature
&& defined $docnode && ($generateConstructors || !$isConstructor) )
{
my $javadocComment = printJavadocComment( $docnode, "", "\t", "" );
$methodCode .= "\t/**" . $javadocComment . "*/\n" unless $javadocComment =~ /^\s*$/;
}
while($iterationCount >= 0) {
$javaMethods->{$javaSignature} = 1;
local($") = ",";
if($firstUnknownArgType <= scalar(@argTypeList) || $hasDuplicateSignature || ($name =~ /^qObject$/) || $m->{Access} =~ /dcop/ ) {
if ( $firstUnknownArgType <= scalar(@argTypeList) || $m->{Access} =~ /dcop/ ) {
my $failedConversion = "\t// " . $m->{ReturnType} . " $name(@castedArgList[0..$#argTypeList]); >>>> NOT CONVERTED\n";
if ( $m->{Access} =~ /signals/ ) {
$signalCode .= $failedConversion;
} else {
$methodCode .= $failedConversion;
}
}
} else {
if ($name eq 'find' and $javaClassName eq 'TQButtonGroup') {
# Can't override a static method find() in TQWidget
$name = "findButton";
} elsif ( $name eq 'null' ) {
$name = "nil";
} elsif ( $name eq 'form' and $javaClassName =~ /^HTML/ ) {
$name = "formElement";
} elsif ( $name eq 'wait' and $javaClassName eq 'KProcess' ) {
$name = "waitThread";
} elsif ( $name eq 'finalize' and $javaClassName eq 'KMD5' ) {
$name = "finalizeDigest";
} elsif ( $name eq 'icon' and $javaClassName eq 'TQMessageBox' ) {
$name = "iconId";
} elsif ( $name eq 'icon' and $javaClassName eq 'KURLBarItemDialog' ) {
$name = "iconName";
} elsif ( $name eq 'iconText' and $javaClassName eq 'KToolBar' ) {
$name = "iconTextId";
} elsif ( $name eq 'reset' and $javaClassName eq 'KExtendedSocket' ) {
$name = "resetSocket";
} elsif ( $name eq 'palette' and $javaClassName eq 'KPaletteTable' ) {
$name = "paletteName";
} elsif ( $name eq 'size' and $javaClassName eq 'KFontCombo' ) {
$name = "pointSize";
} elsif ($javaSignature eq "icon()" and $javaClassName eq 'KIconButton') {
$name = "iconName";
} elsif ($javaSignature eq "close()" and $javaClassName eq 'KDirOperator') {
$name = "closeLoading";
} elsif ($javaSignature eq "font()" and $javaClassName eq 'KCharSelect') {
$name = "fontName";
} elsif ($javaSignature eq "layout()" and $javaReturnType eq 'void') {
$name = "updateLayout";
} elsif ( $name eq 'sorting' and $javaReturnType eq 'boolean' ) {
$name = "sortOnInsert";
}
my $javaparams = join( ", ", @javaArgTypeList );
my $cplusplusparams;
my $i = 0;
for my $arg (@argTypeList) {
$cplusplusparams .= "," if $i++;
$cplusplusparams .= "arg" . $i;
}
if ($isConstructor) {
if ( $generateConstructors && $mainClassNode->{CanBeInstanciated} ) {
$proxyInterfaceCode .= "\t\tvoid new$javaClassName($javaparams);\n";
$methodCode .= "\tpublic $javaClassName($javaparams) {\n";
if ( $ancestorCount > 0 ) {
# $methodCode .= ", $superClassName" . "Interface.class, $superClassName" . "ProtectedInterface.class";
$methodCode .= "\t\tsuper(new Class[] {$javaClassName" . "ProxyInterface.class";
my @super = direct_superclass_list($classNode);
for my $s (@super) {
$methodCode .= ", null";
}
$methodCode .= " }, 1);\n";
} else {
$methodCode .= "\t\tthis(new Class[] { null }, 0);\n";
}
# $methodCode .= " },\n\t\t\tnew SmokeInvocation(this, ";
$methodCode .= "\t\tnew$javaClassName(@javaArgList[0..$#javaArgTypeList]);\n";
$methodCode .= "\t}\n";
$methodCode .= "\tprotected void new$javaClassName($javaparams) {\n";
$methodCode .= "\t\tproxy$javaClassName().new$javaClassName(@javaArgList[0..$#javaArgTypeList]);\n";
$methodCode .= "\t}\n";
}
} else {
my $access = $m->{Access};
$access =~ s/_slots//;
if ( $access eq 'public' or $access eq 'protected' ) {
if ( $name =~ /^takeItem$|^setPixmap$|^clearCell$|^setItem$|^item$|^minimumSize$/
or $name =~ /^stepUp$|^stepDown$|^sectionFormattedText$|^addNumber$|^removeLastNumber$/
or $name =~ /^cancel$|^setSource$|^paintCell$|^updateContents$|^sizeHint$|^setFocusSection$/
or $name =~ /^event$|^eventFilter$|^copy$|^detach$|^showEvent$|^format$|^encodedData$/
or $name =~ /^styleChange$|^insertItem$|^setStatus$|^setState$|^minimumSizeHint$/
or $name =~ /^updateGeometry$|^setState$|^exec$|^pixmap$|^areaPoints$|^draw$|^writeDir$/ ) {
# These methods are public in some places, but protected in others,
# so make them all public.
$access = "public";
}
$methodCode .= "\t" . $access . (($isStatic or $classNode->{NodeType} eq 'namespace') ? " static " : " ");
# $methodCode .= ( $m->{Flags} =~ "v" || $isStatic ? "" : "final " );
my $altReturnType = undef;
if ($name =~ /^xForm$/ ) {
$javaReturnType = "Object";
} elsif ($javaSignature eq "layout()" and $javaReturnType ne 'void') {
$altReturnType = "TQLayout";
} elsif ($javaSignature eq "defaultFactory()" and $javaReturnType eq 'TQSqlEditorFactory') {
$javaReturnType = "TQEditorFactory";
} elsif ($javaSignature eq "statusBar()") {
$altReturnType = "TQStatusBar";
} elsif ($javaSignature eq "menuBar()") {
$altReturnType = "TQMenuBar";
} elsif ($javaSignature =~ /^bits|^scanLine/) {
$javaReturnType = "byte[]";
} elsif ($javaSignature eq "at()" and $javaClassName eq 'KFilterDev') {
$javaReturnType = "long";
} elsif ($javaSignature =~ /copyTo/ and $javaClassName eq "KDesktopFile" ) {
$altReturnType = "KConfig";
}
if ( defined $altReturnType ) {
checkImportsForObject( $altReturnType, $addImport );
$javaReturnType = $altReturnType;
}
if ($access eq 'public' && ! $isStatic) {
$interfaceCode .= "\t\t$javaReturnType $name($javaparams);\n";
}
$proxyInterfaceCode .= "\t\t$javaReturnType $name($javaparams);\n";
$methodCode .= $javaReturnType;
$methodCode .= " $name($javaparams) \{\n";
$methodCode .= "\t\t" . ($javaReturnType ne "void" ? "return " : "");
$methodCode .= (($isStatic or $classNode->{NodeType} eq 'namespace') ? "static" : "proxy") . "$javaClassName().$name(@javaArgList[0..$#javaArgTypeList]);\n";
$methodCode .= "\t}\n";
} else {
if ( $access =~ /signals/ ) {
my $docnode = $m->{DocNode};
if ( defined $docnode ) {
my $javadocComment = printJavadocComment( $docnode, "", "\t", "" );
$signalCode .= "\t/**" . $javadocComment . "*/\n" unless $javadocComment =~ /^\s*$/;
}
$signalCode .= "\tvoid $name($javaparams);\n";
}
}
}
}
pop @argTypeList;
pop @javaArgTypeList;
pop @javaArgList;
$javaSignature = javaMethodSignature( $m, @argTypeList );
$hasDuplicateSignature = (defined $javaMethods->{$javaSignature} ? 1 : 0);
$methodNumber++;
$iterationCount--;
} # Iteration loop
return ( $methodCode, $interfaceCode, $proxyInterfaceCode, $signalCode );
}
sub generateEnum($$$)
{
my( $classNode, $m, $generateAnonymous ) = @_; # input
my $methodCode = ''; # output
my @heritage = kdocAstUtil::heritage($classNode);
my $className = join( "::", @heritage );
my $javaClassName = $classNode->{astNodeName};
if ( ($generateAnonymous and $m->{astNodeName} ) or (! $generateAnonymous and ! $m->{astNodeName}) ) {
return;
}
if ( defined $m->{DocNode} ) {
my $javadocComment = printJavadocComment( $m->{DocNode}, "", "\t", "" );
$methodCode .= "\t/**" . $javadocComment . "*/\n" unless $javadocComment =~ /^\s*$/;
}
my @enums = split(",", $m->{Params});
my $enumCount = 0;
foreach my $enum ( @enums ) {
$enum =~ s/\s//g;
$enum =~ s/::/./g;
$enum =~ s/\(mode_t\)//;
if ( $enum =~ /(.*)=([-0-9]+)$/ ) {
$methodCode .= "\tpublic static final int $1 = $2;\n";
$enumCount = $2;
$enumCount++;
} elsif ( $enum =~ /(.*)=(.*)/ ) {
$methodCode .= "\tpublic static final int $1 = $2;\n";
} else {
$methodCode .= "\tpublic static final int $enum = $enumCount;\n";
$enumCount++;
}
}
$methodCode .= "\n";
$methodNumber++;
return ( $methodCode );
}
sub generateVar($$$)
{
my( $classNode, $m, $addImport ) = @_; # input
my $methodCode = ''; # output
my $interfaceCode = ''; # output
my @heritage = kdocAstUtil::heritage($classNode);
my $className = join( "::", @heritage );
my $javaClassName = $classNode->{astNodeName};
my $name = $m->{astNodeName};
my $varType = $m->{Type};
$varType =~ s/static\s//;
$varType =~ s/const\s+(.*)\s*&/$1/;
$varType =~ s/\s*$//;
my $fullName = "$className\::$name";
checkImportsForObject( $varType, $addImport );
# die "Invalid index for $fullName: $classNode->{case}{$fullName} instead of $methodNumber" if $classNode->{case}{$fullName} != $methodNumber;
# $methodCode .= " static void x_$methodNumber(Smoke::Stack x) {\n";
# $methodCode .= "\tx[0].s_class = (void*)new $varType($fullName);\n";
# $methodCode .= " }\n";
# if ( ($name !~ /^null$/) && (cplusplusToJava($varType) ne "") ) {
if ( ($name !~ /^null$/) && (cplusplusToJava($varType) ne "" ) ) {
# $interfaceCode .= "\t\t". cplusplusToJava($varType) . " $name();\n";
# $methodCode .= "\tpublic native static ". cplusplusToJava($varType) . " $name();\n";
}
$methodNumber++;
return ( $methodCode, $interfaceCode );
}
## Called by writeClassDoc
sub generateAllMethods($$$$$$)
{
my ($classNode, $ancestorCount, $javaMethods, $mainClassNode, $generateConstructors, $addImport) = @_;
my $methodCode = '';
my $interfaceCode = '';
my $proxyInterfaceCode = '';
my $signalCode = '';
$methodNumber = 0;
#my $className = $classNode->{astNodeName};
my $className = join( "::", kdocAstUtil::heritage($classNode) );
my $javaClassName = $mainClassNode->{astNodeName};
# If the C++ class had multiple inheritance, then the code for all but one of the
# parents must be copied into the code for javaClassName. Hence, for TQWidget current
# classname might be TQPaintDevice, as its methods are needed in TQWidget.
my $currentClassName = join( ".", kdocAstUtil::heritage($classNode) );
my $sourcename = $classNode->{Source}->{astNodeName};
if ( $sourcename !~ s!.*(kio/|kparts/|dom/|kabc/|ksettings/|kjs/|ktexteditor/|tdeprint/|tdesu/)(.*)!$1$2!m ) {
$sourcename =~ s!.*/(.*)!$1!m;
}
die "Empty source name for $classNode->{astNodeName}" if ( $sourcename eq '' );
if ($generateConstructors) {
$methodCode .= " \tprivate $javaClassName" . "ProxyInterface proxy$javaClassName() {\n";
$methodCode .= " \t\treturn ($javaClassName". "ProxyInterface) _proxy;\n\t}\n";
$methodCode .= " \tprivate static Object _static_proxy = null;\n";
$methodCode .= "\tstatic {\n";
$methodCode .= "\t\t_static_proxy = Proxy.newProxyInstance(";
$methodCode .= "$javaClassName.class.getClassLoader(),\n";
$methodCode .= "\t\t\tnew Class[] { $javaClassName" . "ProxyInterface.class";
$methodCode .= " },\n\t\t\tnew SmokeInvocation() );\n";
$methodCode .= "\t}\n\n";
$methodCode .= " \tprivate static $javaClassName" . "ProxyInterface static$javaClassName() {\n";
$methodCode .= " \t\treturn ($javaClassName". "ProxyInterface) _static_proxy;\n\t}\n";
}
if ($classNode->{astNodeName} ne $main::globalSpaceClassName) {
# my $s;
# for my $sn( @{$classNode->{Sources}} ) {
# if ( ($s = $sn->{astNodeName}) !~ s!.*(kio/|kparts/|dom/|kabc/|ksettings/|kjs/|ktexteditor/|tdeprint/|tdesu/)(.*)!$1$2!m ) {
# $s =~ s!.*/(.*)!$1!m;
# }
# $addInclude->{$s} = 1;
# }
}
$addImport->{"org.kde.qt.QtSupport"} = 1;
# Do all enums first, anonymous ones and then named enums
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq 'enum' and $currentClassName eq $javaClassName ) {
my ($meth) = generateEnum( $classNode, $methodNode, 1 );
$methodCode .= $meth;
}
}, undef );
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq 'enum' and $currentClassName eq $javaClassName ) {
my ($meth) = generateEnum( $classNode, $methodNode, 0 );
$methodCode .= $meth;
}
}, undef );
# Then all static vars
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq 'var' and $currentClassName eq $javaClassName ) {
my ($meth, $interface) = generateVar( $classNode, $methodNode, $addImport );
$methodCode .= $meth;
# $interfaceCode .= $interface;
}
}, undef );
# Then all methods
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq 'method' ) {
my ($meth, $interface, $proxyInterface, $signals) = generateMethod( $classNode, $methodNode, $addImport, $ancestorCount, $javaMethods, $mainClassNode, $generateConstructors );
$methodCode .= $meth;
$interfaceCode .= $interface;
$proxyInterfaceCode .= $proxyInterface;
$signalCode .= $signals;
}
}, undef );
# Virtual methods
# if ($classNode->{BindingDerives}) {
# my %virtualMethods;
# allVirtualMethods( $classNode, \%virtualMethods );
# for my $sig (sort keys %virtualMethods) {
# my ($meth) = generateVirtualMethod( $classNode, $sig, $virtualMethods{$sig}{method}, $virtualMethods{$sig}{class}, \%addImport );
# $methodCode .= $meth;
# }
# }
# Destructor
# "virtual" is useless, if the base class has a virtual destructor then the x_* class too.
#if($classNode->{HasVirtualDestructor} and $classNode->{HasDestructor}) {
# $methodCode .= " virtual ~$bridgeClassName() {}\n";
#}
# We generate a dtor though, because we might want to add stuff into it
if ($currentClassName eq $javaClassName and $classNode->{CanBeInstanciated} and $classNode->{HasPublicDestructor}) {
if ( $generateConstructors ) {
$methodCode .= "\tprotected void finalize() throws InternalError {\n";
$methodCode .= "\t\tproxy$javaClassName().dispose();\n\t}\n";
$proxyInterfaceCode .= "\t\tvoid dispose();\n";
$methodCode .= "\tpublic void dispose() {\n";
$methodCode .= "\t\tproxy$javaClassName().dispose();\n\t}\n";
$proxyInterfaceCode .= "\t\tboolean isDisposed();\n";
$methodCode .= "\tpublic boolean isDisposed() {\n";
$methodCode .= "\t\treturn proxy$javaClassName().isDisposed();\n\t}\n";
}
# die "$className destructor: methodNumber=$methodNumber != case entry=".$classNode->{case}{"~$className()"}."\n"
# if $methodNumber != $classNode->{case}{"~$className()"};
$methodNumber++;
}
return ( $methodCode, $interfaceCode, $proxyInterfaceCode, $signalCode );
}
# Return 0 if the class has no virtual dtor, 1 if it has, 2 if it's private
sub hasVirtualDestructor($)
{
my ( $classNode ) = @_;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
return if ( $skippedClasses{$className} );
my $parentHasIt;
# Look at ancestors, and (recursively) call hasVirtualDestructor for each
# It's enough to have one parent with a prot/public virtual dtor
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
my $vd = hasVirtualDestructor( $_[0] );
$parentHasIt = $vd unless $parentHasIt > $vd;
} );
return $parentHasIt if $parentHasIt; # 1 or 2
# Now look in $classNode - including private methods
my $doPrivate = $main::doPrivate;
$main::doPrivate = 1;
my $result;
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
return unless( $m->{NodeType} eq "method" && $m->{ReturnType} eq '~' );
if ( $m->{Flags} =~ /[vp]/ ) {
if ( $m->{Access} =~ /private/ ) {
$result=2; # private virtual
} else {
$result=1; # [protected or public] virtual
}
}
},
undef
);
$main::doPrivate = $doPrivate;
$result=0 if (!defined $result);
return $result;
}
=head2 allVirtualMethods
Parameters: class node, dict
Adds to the dict, for all method nodes that are virtual, in this class and in parent classes :
{method} the method node, {class} the class node (the one where the virtual is implemented)
=cut
sub allVirtualMethods($$)
{
my ( $classNode, $virtualMethods ) = @_;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
return if ( $skippedClasses{$className} );
# Look at ancestors, and (recursively) call allVirtualMethods for each
# This is done first, so that virtual methods that are reimplemented as 'private'
# can be removed from the list afterwards (below)
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
allVirtualMethods( @_[0], $virtualMethods );
}, undef
);
# Now look for virtual methods in $classNode - including private ones
my $doPrivate = $main::doPrivate;
$main::doPrivate = 1;
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
# Only interested in methods, and skip destructors
return unless( $m->{NodeType} eq "method" && $m->{ReturnType} ne '~' );
my $signature = methodSignature( $m, $#{$m->{ParamList}} );
print STDERR $signature . " ($m->{Access})\n" if ($debug);
# A method is virtual if marked as such (v=virtual p=pure virtual)
# or if a parent method with same signature was virtual
if ( $m->{Flags} =~ /[vp]/ or defined $virtualMethods->{$signature} ) {
if ( $m->{Access} =~ /private/ ) {
if ( defined $virtualMethods->{$signature} ) { # remove previously defined
delete $virtualMethods->{$signature};
}
# else, nothing, just ignore private virtual method
} else {
$virtualMethods->{$signature}{method} = $m;
$virtualMethods->{$signature}{class} = $classNode;
}
}
},
undef
);
$main::doPrivate = $doPrivate;
}
# Known typedef? If so, apply it.
sub applyTypeDef($)
{
my $type = shift;
# Parse 'const' in front of it, and '*' or '&' after it
my $prefix = $type =~ s/^const\s+// ? 'const ' : '';
my $suffix = $type =~ s/\s*([\&\*]+)$// ? $1 : '';
if (exists $typedeflist{$type}) {
return $prefix.$typedeflist{$type}.$suffix;
}
return $prefix.$type.$suffix;
}
# Register type ($1) into %allTypes if not already there
sub registerType($$) {
my $type = shift;
#print "registerType: $type\n" if ($debug);
$type =~ s/\s+const$//; # for 'char* const'
$type =~ s/\s+const\s*\*$/\*/; # for 'char* const*'
return if ( $type eq 'void' or $type eq '' or $type eq '~' );
die if ( $type eq '...' ); # ouch
# Let's register the real type, not its known equivalent
#$type = applyTypeDef($type);
# Enum _value_ -> get corresponding type
if (exists $enumValueToType{$type}) {
$type = $enumValueToType{$type};
}
# Already in allTypes
if(exists $allTypes{$type}) {
return;
}
die if $type eq 'TQTextEdit::UndoRedoInfo::Type';
die if $type eq '';
my $realType = $type;
# Look for references (&) and pointers (* or **) - this will not handle *& correctly.
# We do this parsing here because both the type list and iterproto need it
if($realType =~ s/&$//) {
$allTypes{$type}{typeFlags} = 'Smoke::tf_ref';
}
elsif($realType ne 'void*' && $realType =~ s/\*$//) {
$allTypes{$type}{typeFlags} = 'Smoke::tf_ptr';
}
else {
$allTypes{$type}{typeFlags} = 'Smoke::tf_stack';
}
if ( $realType =~ s/^const\s+// ) { # Remove 'const'
$allTypes{$type}{typeFlags} .= ' | Smoke::tf_const';
}
# Apply typedefs, and store the resulting type.
# For instance, if $type was Q_UINT16&, realType will be ushort
$allTypes{$type}{realType} = applyTypeDef( $realType );
# In the first phase we only create entries into allTypes.
# The values (indexes) are calculated afterwards, once the list is full.
$allTypes{$type}{index} = -1;
#print STDERR "Register $type. Realtype: $realType\n" if($debug);
}
# Get type from %allTypes
# This returns a hash with {index}, {isEnum}, {typeFlags}, {realType}
# (and {typeId} after the types array is written by writeSmokeDataFile)
sub findTypeEntry($) {
my $type = shift;
my $typeIndex = -1;
$type =~ s/\s+const$//; # for 'char* const'
$type =~ s/\s+const\s*\*$/\*/; # for 'char* const*'
return undef if ( $type =~ '~' or $type eq 'void' or $type eq '' );
# Enum _value_ -> get corresponding type
if (exists $enumValueToType{$type}) {
$type = $enumValueToType{$type};
}
die "type not known: $type" unless defined $allTypes{$type};
return $allTypes{ $type };
}
# List of all java super-classes for a given class, via single inheritance.
# Excluding any which are mapped onto interfaces to avoid multiple inheritance.
sub direct_superclass_list($)
{
my $classNode = shift;
my @super;
my $has_ancestor = 0;
my $direct_ancestor = undef;
my $name;
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
( $direct_ancestor, $name ) = @_;
if ($name =~ /TQMemArray|TQSqlFieldInfoList/) {
# Template classes, give up for now..
$has_ancestor = 1;
} elsif (kalyptusDataDict::interfacemap($name) eq "") {
push @super, $direct_ancestor;
push @super, direct_superclass_list( $direct_ancestor );
$has_ancestor = 1;
}
}, undef );
if (! $has_ancestor and defined $direct_ancestor) {
push @super, $direct_ancestor;
push @super, direct_superclass_list( $direct_ancestor );
}
return @super;
}
# List of all super-classes for a given class
sub superclass_list($)
{
my $classNode = shift;
my @super;
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
push @super, @_[0];
push @super, superclass_list( @_[0] );
}, undef );
return @super;
}
sub is_kindof($$)
{
my $classNode = shift;
my $className = shift;
if ($classNode->{astNodeName} eq $className) {
return 1;
}
my @superclasses = superclass_list($classNode);
foreach my $ancestor (@superclasses) {
if ($ancestor->{astNodeName} eq $className) {
return 1;
}
}
return 0;
}
# Store the {case} dict in the class Node (method signature -> index in the "case" switch)
# This also determines which methods should NOT be in the switch, and sets {SkipFromSwitch} for them
sub prepareCaseDict($) {
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
$classNode->AddProp("case", {});
my $methodNumber = 0;
# First look at all enums for this class
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
next unless $m->{NodeType} eq 'enum';
foreach my $val ( @{$m->{ParamList}} ) {
my $fullEnumName = "$className\::".$val->{ArgName};
print STDERR "Enum: $fullEnumName -> case $methodNumber\n" if ($debug);
$classNode->{case}{$fullEnumName} = $methodNumber;
$enumValueToType{$fullEnumName} = "$className\::$m->{astNodeName}";
$methodNumber++;
}
}, undef );
# Check for static vars
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
next unless $m->{NodeType} eq 'var';
my $name = "$className\::".$m->{astNodeName};
print STDERR "Var: $name -> case $methodNumber\n" if ($debug);
$classNode->{case}{$name} = $methodNumber;
$methodNumber++;
}, undef );
# Now look at all methods for this class
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
next unless $m->{NodeType} eq 'method';
my $name = $m->{astNodeName};
my $isConstructor = ($name eq $classNode->{astNodeName} );
if ($isConstructor and ($m->{ReturnType} eq '~')) # destructor
{
# Remember whether we'll generate a switch entry for the destructor
$m->{SkipFromSwitch} = 1 unless ($classNode->{CanBeInstanciated} and $classNode->{HasPublicDestructor});
next;
}
# Don't generate bindings for protected methods (incl. signals) if
# we're not deriving from the C++ class. Only take public and public_slots
my $ok = ( $classNode->{BindingDerives} or $m->{Access} =~ /public/ ) ? 1 : 0;
# Don't generate bindings for pure virtuals - we can't call them ;)
$ok = 0 if ( $ok && $m->{Flags} =~ "p" );
# Bugfix for Qt-3.0.4: those methods are NOT implemented (report sent).
$ok = 0 if ( $ok && $className eq 'TQLineEdit' && ( $name eq 'setPasswordChar' || $name eq 'passwordChar' ) );
$ok = 0 if ( $ok && $className eq 'TQWidgetItem' && $name eq 'widgetSizeHint' );
if ( !$ok )
{
#print STDERR "Skipping $className\::$name\n" if ($debug);
$m->{SkipFromSwitch} = 1;
next;
}
my @args = @{ $m->{ParamList} };
my $last = $m->{FirstDefaultParam};
$last = scalar @args unless defined $last;
my $iterationCount = scalar(@args) - $last;
while($iterationCount >= 0) {
my $sig = methodSignature( $m, $#args );
$classNode->{case}{$sig} = $methodNumber;
#print STDERR "prepareCaseDict: registered case number $methodNumber for $sig in $className()\n" if ($debug);
pop @args;
$iterationCount--;
$methodNumber++;
}
}, undef );
# Add the destructor, at the end
if ($classNode->{CanBeInstanciated} and $classNode->{HasPublicDestructor}) {
$classNode->{case}{"~$className()"} = $methodNumber;
# workaround for ~Sub::Class() being seen as Sub::~Class()
$classNode->{case}{"~$classNode->{astNodeName}()"} = $methodNumber;
#print STDERR "prepareCaseDict: registered case number $methodNumber for ~$className()\n" if ($debug);
}
}
sub writeSmokeDataFile($) {
my $rootnode = shift;
# Make list of classes
my %allImports; # list of all header files for all classes
my @classlist;
push @classlist, ""; # Prepend empty item for "no class"
my %enumclasslist;
Iter::LocalCompounds( $rootnode, sub {
my $classNode = $_[0];
my $className = join( "::", kdocAstUtil::heritage($classNode) );
return if $classNode->{NodeType} eq 'namespace';
push @classlist, $className;
$enumclasslist{$className}++ if keys %{$classNode->{enumerations}};
$classNode->{ClassIndex} = $#classlist;
addImportForClass( $classNode, \%allImports, undef );
} );
my %classidx = do { my $i = 0; map { $_ => $i++ } @classlist };
my $file = "$outputdir/smokedata.cpp";
# open OUT, ">$file" or die "Couldn't create $file\n";
# foreach my $incl (sort{
# return 1 if $a=~/qmotif/; # move qmotif* at bottom (they include dirty X11 headers)
# return -1 if $b=~/qmotif/;
# return -1 if substr($a,0,1) eq 'q' and substr($b,0,1) ne 'q'; # move Qt headers on top
# return 1 if substr($a,0,1) ne 'q' and substr($b,0,1) eq 'q';
# $a cmp $b
# } keys %allIncludes) {
# die if $imp eq '';
# print OUT "import $imp;\n";
# }
# print OUT "\n";
print STDERR "Writing ${libname}_cast function\n" if ($debug);
# Prepare descendants information for each class
my %descendants; # classname -> list of descendant nodes
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
# Get _all_ superclasses (up any number of levels)
# and store that $classNode is a descendant of $s
my @super = superclass_list($classNode);
for my $s (@super) {
my $superClassName = join( "::", kdocAstUtil::heritage($s) );
Ast::AddPropList( \%descendants, $superClassName, $classNode );
}
} );
# Iterate over all classes, to write the xtypecast function
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
# @super will contain superclasses, the class itself, and all descendants
my @super = superclass_list($classNode);
push @super, $classNode;
if ( defined $descendants{$className} ) {
push @super, @{$descendants{$className}};
}
my $cur = $classidx{$className};
return if $classNode->{NodeType} eq 'namespace';
# print OUT " case $cur:\t//$className\n";
# print OUT "\tswitch(to) {\n";
# $cur = -1;
# my %casevalues;
# for my $s (@super) {
# my $superClassName = join( "::", kdocAstUtil::heritage($s) );
# next if !defined $classidx{$superClassName}; # inherits from unknown class, see below
# next if $classidx{$superClassName} == $cur; # shouldn't happen in Qt
# next if $s->kdocAstUtil::inheritsAsVirtual($classNode); # can't cast from a virtual base class
# $cur = $classidx{$superClassName}; # KDE has MI with diamond shaped cycles (cf. KXMLGUIClient)
# next if $casevalues{$cur}; # ..so skip any duplicate parents
# print OUT "\t case $cur: return (void*)($superClassName*)($className*)xptr;\n";
# $casevalues{$cur} = 1;
# }
# print OUT "\t default: return xptr;\n";
# print OUT "\t}\n";
} );
# print OUT " default: return xptr;\n";
# print OUT " }\n";
# print OUT "}\n\n";
# Write inheritance array
# Imagine you have "Class : public super1, super2"
# The inheritlist array will get 3 new items: super1, super2, 0
my %inheritfinder; # key = (super1, super2) -> data = (index in @inheritlist). This one allows reuse.
my %classinherit; # we store that index in %classinherit{className}
# We don't actually need to store inheritlist in memory, we write it
# directly to the file. We only need to remember its current size.
my $inheritlistsize = 1;
# print OUT "// Group of class IDs (0 separated) used as super class lists.\n";
# print OUT "// Classes with super classes have an index into this array.\n";
# print OUT "static short ${libname}_inheritanceList[] = {\n";
# print OUT "\t0,\t// 0: (no super class)\n";
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "__", kdocAstUtil::heritage($classNode) );
return if $classNode->{NodeType} eq 'namespace';
print STDERR "inheritanceList: looking at $className\n" if ($debug);
# Make list of direct ancestors
my @super;
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
my $superClassName = join( "::", kdocAstUtil::heritage($_[0]) );
push @super, $superClassName;
}, undef );
# Turn that into a list of class indexes
my $key = '';
foreach my $superClass( @super ) {
if (defined $classidx{$superClass}) {
$key .= ', ' if ( length $key > 0 );
$key .= $classidx{$superClass};
}
}
if ( $key ne '' ) {
if ( !defined $inheritfinder{$key} ) {
print OUT "\t";
my $index = $inheritlistsize; # Index of first entry (for this group) in inheritlist
foreach my $superClass( @super ) {
if (defined $classidx{$superClass}) {
print OUT "$classidx{$superClass}, ";
$inheritlistsize++;
}
}
$inheritlistsize++;
my $comment = join( ", ", @super );
print OUT "0,\t// $index: $comment\n";
$inheritfinder{$key} = $index;
}
$classinherit{$className} = $inheritfinder{$key};
} else { # No superclass
$classinherit{$className} = 0;
}
} );
# print OUT "};\n\n";
# print OUT "// These are the xenum functions for manipulating enum pointers\n";
for my $className (keys %enumclasslist) {
my $c = $className;
$c =~ s/::/__/g;
# print OUT "void xenum_$c\(Smoke::EnumOperation, Smoke::Index, void*&, long&);\n";
}
# print OUT "\n";
# print OUT "// Those are the xcall functions defined in each x_*.cpp file, for dispatching method calls\n";
my $firstClass = 1;
for my $className (@classlist) {
if ($firstClass) {
$firstClass = 0;
next;
}
my $c = $className; # make a copy
$c =~ s/::/__/g;
# print OUT "void xcall_$c\(Smoke::Index, void*, Smoke::Stack);\n";
}
# print OUT "\n";
# Write class list afterwards because it needs offsets to the inheritance array.
# print OUT "// List of all classes\n";
# print OUT "// Name, index into inheritanceList, method dispatcher, enum dispatcher, class flags\n";
# print OUT "static Smoke::Class ${libname}_classes[] = {\n";
my $firstClass = 1;
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "__", kdocAstUtil::heritage($classNode) );
return if $classNode->{NodeType} eq 'namespace';
if ($firstClass) {
$firstClass = 0;
print OUT "\t{ 0L, 0, 0, 0, 0 }, \t// 0 (no class)\n";
}
my $c = $className;
$c =~ s/::/__/g;
my $xcallFunc = "xcall_$c";
my $xenumFunc = "0";
$xenumFunc = "xenum_$c" if exists $enumclasslist{$className};
# %classinherit needs Foo__Bar, not Foo::Bar?
die "problem with $className" unless defined $classinherit{$c};
my $xClassFlags = 0;
$xClassFlags .= "|Smoke::cf_constructor" if $classNode->{CanBeInstanciated}; # correct?
$xClassFlags .= "|Smoke::cf_deepcopy" if $classNode->{CanBeCopied}; # HasCopyConstructor would be wrong (when it's private)
$xClassFlags .= "|Smoke::cf_virtual" if hasVirtualDestructor($classNode) == 1;
# $xClassFlags .= "|Smoke::cf_undefined" if ...;
$xClassFlags =~ s/0\|//; # beautify
# print OUT "\t{ \"$className\", $classinherit{$c}, $xcallFunc, $xenumFunc, $xClassFlags }, \t//$classidx{$className}\n";
} );
# print OUT "};\n\n";
# print OUT "// List of all types needed by the methods (arguments and return values)\n";
# print OUT "// Name, class ID if arg is a class, and TypeId\n";
# print OUT "static Smoke::Type ${libname}_types[] = {\n";
my $typeCount = 0;
$allTypes{''}{index} = 0; # We need an "item 0"
for my $type (sort keys %allTypes) {
$allTypes{$type}{index} = $typeCount; # Register proper index in allTypes
if ( $typeCount == 0 ) {
# print OUT "\t{ 0, 0, 0 },\t//0 (no type)\n";
$typeCount++;
next;
}
my $isEnum = $allTypes{$type}{isEnum};
my $typeId;
my $typeFlags = $allTypes{$type}{typeFlags};
my $realType = $allTypes{$type}{realType};
die "$type" if !defined $typeFlags;
# die "$realType" if $realType =~ /\(/;
# First write the name
# print OUT "\t{ \"$type\", ";
# Then write the classId (and find out the typeid at the same time)
if(exists $classidx{$realType}) { # this one first, we want t_class for TQBlah*
$typeId = 't_class';
# print OUT "$classidx{$realType}, ";
}
elsif($type =~ /&$/ || $type =~ /\*$/) {
$typeId = 't_voidp';
# print OUT "0, "; # no classId
}
elsif($isEnum || $allTypes{$realType}{isEnum}) {
$typeId = 't_enum';
if($realType =~ /(.*)::/) {
my $c = $1;
if($classidx{$c}) {
# print OUT "$classidx{$c}, ";
} else {
# print OUT "0 /* unknown class $c */, ";
}
} else {
# print OUT "0 /* unknown $realType */, "; # no classId
}
}
else {
$typeId = $typeunion{$realType};
if (defined $typeId) {
$typeId =~ s/s_/t_/; # from s_short to t_short for instance
}
else {
# Not a known class - ouch, this happens quite a lot
# (private classes, typedefs, template-based types, etc)
if ( $skippedClasses{$realType} ) {
# print STDERR "$realType has been skipped, using t_voidp for it\n";
} else {
unless( $realType =~ /</ ) { # Don't warn for template stuff...
print STDERR "$realType isn't a known type (type=$type)\n";
}
}
$typeId = 't_voidp'; # Unknown -> map to a void *
}
# print OUT "0, "; # no classId
}
# Then write the flags
die "$type" if !defined $typeId;
# print OUT "Smoke::$typeId | $typeFlags },";
# print OUT "\t//$typeCount\n";
$typeCount++;
# Remember it for coerce_type
$allTypes{$type}{typeId} = $typeId;
}
# print OUT "};\n\n";
my %arglist; # registers the needs for argumentList (groups of type ids)
my %methods;
# Look for all methods and all enums, in all classes
# And fill in methods and arglist. This loop writes nothing to OUT.
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
print STDERR "writeSmokeDataFile: arglist: looking at $className\n" if ($debug);
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
my $methName = $m->{astNodeName};
# For destructors, get a proper signature that includes the '~'
if ( $m->{ReturnType} eq '~' )
{
$methName = '~' . $methName ;
# Let's even store that change, otherwise we have to do it many times
$m->{astNodeName} = $methName;
}
if( $m->{NodeType} eq "enum" ) {
foreach my $enum ( @{$m->{ParamList}} ) {
my $enumName = $enum->{ArgName};
$methods{$enumName}++;
}
} elsif ( $m->{NodeType} eq 'var' ) {
$methods{$m->{astNodeName}}++;
} elsif( $m->{NodeType} eq "method" ) {
$methods{$methName}++;
my @protos;
makeprotos(\%classidx, $m, \@protos);
#print "made @protos from $className $methName $m->{Signature})\n" if ($debug);
for my $p (@protos) {
$methods{$p}++;
my $argcnt = 0;
$argcnt = length($1) if $p =~ /([\$\#\?]+)/;
my $sig = methodSignature($m, $argcnt-1);
# Store in a class hash named "proto", a proto+signature => method association
$classNode->{proto}{$p}{$sig} = $m;
#$classNode->{signature}{$sig} = $p;
# There's probably a way to do this better, but this is the fastest way
# to get the old code going: store classname into method
$m->{class} = $className;
}
my $firstDefaultParam = $m->{FirstDefaultParam};
$firstDefaultParam = scalar(@{ $m->{ParamList} }) unless defined $firstDefaultParam;
my $argNames = '';
my $args = '';
for(my $i = 0; $i < @{ $m->{ParamList} }; $i++) {
$args .= ', ' if $i;
$argNames .= ', ' if $i;
my $argType = $m->{ParamList}[$i]{ArgType};
my $typeEntry = findTypeEntry( $argType );
$args .= defined $typeEntry ? $typeEntry->{index} : 0;
$argNames .= $argType;
if($i >= ($firstDefaultParam - 1)) {
#print "arglist entry: $args\n";
$arglist{$args} = $argNames;
}
}
# create an entry for e.g. "arg0,arg1,arg2" where argN is index in allTypes of type for argN
# The value, $argNames, is temporarily stored, to be written out as comment
# It gets replaced with the index in the next loop.
#print "arglist entry : $args\n";
$arglist{$args} = $argNames;
}
}, # end of sub
undef
);
});
$arglist{''} = 0;
# Print arguments array
# print OUT "static Smoke::Index ${libname}_argumentList[] = {\n";
my $argListCount = 0;
for my $args (sort keys %arglist) {
my @dunnohowtoavoidthat = split(',',$args);
my $numTypes = $#dunnohowtoavoidthat;
if ($args eq '') {
# print OUT "\t0,\t//0 (void)\n";
} else {
# This is a nice trick : args can be written in one go ;)
# print OUT "\t$args, 0,\t//$argListCount $arglist{$args} \n";
}
$arglist{$args} = $argListCount; # Register proper index in argList
$argListCount += $numTypes + 2; # Move forward by as much as we wrote out
}
# print OUT "};\n\n";
$methods{''} = 0;
my @methodlist = sort keys %methods;
my %methodidx = do { my $i = 0; map { $_ => $i++ } @methodlist };
# print OUT "// Raw list of all methods, using munged names\n";
# print OUT "static const char *${libname}_methodNames[] = {\n";
my $methodNameCount = $#methodlist;
for my $m (@methodlist) {
# print OUT qq( "$m",\t//$methodidx{$m}\n);
}
# print OUT "};\n\n";
# print OUT "// (classId, name (index in methodNames), argumentList index, number of args, method flags, return type (index in types), xcall() index)\n";
# print OUT "static Smoke::Method ${libname}_methods[] = {\n";
my @methods;
%allMethods = ();
my $methodCount = 0;
# Look at all classes and all enums again
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
return if $classNode->{NodeType} eq 'namespace';
my $classIndex = $classidx{$className};
print STDERR "writeSmokeDataFile: methods: looking at $className\n" if ($debug);
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
if( $m->{NodeType} eq "enum" ) {
foreach my $enum ( @{$m->{ParamList}} ) {
my $enumName = $enum->{ArgName};
my $fullEnumName = "$className\::$enumName";
my $sig = "$className\::$enumName\()";
my $xmethIndex = $methodidx{$enumName};
die "'Method index' for enum $sig not found" unless defined $xmethIndex;
my $typeId = findTypeEntry( $fullEnumName )->{index};
die "enum has no {case} value in $className: $fullEnumName" unless defined $classNode->{case}{$fullEnumName};
# print OUT "\t{$classIndex, $xmethIndex, 0, 0, Smoke::mf_static, $typeId, $classNode->{case}{$fullEnumName}},\t//$methodCount $fullEnumName (enum)\n";
$allMethods{$sig} = $methodCount;
print STDERR "Added entry for " . $sig . " into \$allMethods\n" if ($debug);
$methods[$methodCount] = {
c => $classIndex,
methIndex => $xmethIndex,
argcnt => '0',
args => 0,
retTypeIndex => 0,
idx => $classNode->{case}{$fullEnumName}
};
$methodCount++;
}
} elsif( $m->{NodeType} eq 'var' ) {
my $name = $m->{astNodeName};
my $fullName = "$className\::$name";
my $sig = "$fullName\()";
my $xmethIndex = $methodidx{$name};
die "'Method index' for var $sig not found" unless defined $xmethIndex;
my $varType = $m->{Type};
$varType =~ s/static\s//;
$varType =~ s/const\s+(.*)\s*&/$1/;
$varType =~ s/\s*$//;
my $typeId = findTypeEntry( $varType )->{index};
die "var has no {case} value in $className: $fullName" unless defined $classNode->{case}{$fullName};
# print OUT "\t{$classIndex, $xmethIndex, 0, 0, Smoke::mf_static, $typeId, $classNode->{case}{$fullName}},\t//$methodCount $fullName (static var)\n";
$allMethods{$sig} = $methodCount;
print STDERR "Added entry for " . $sig . " into \$allMethods\n" if ($debug);
$methods[$methodCount] = {
c => $classIndex,
methIndex => $xmethIndex,
argcnt => '0',
args => 0,
retTypeIndex => 0,
idx => $classNode->{case}{$fullName}
};
$methodCount++;
} elsif( $m->{NodeType} eq "method" ) {
# We generate a method entry only if the method is in the switch() code
# BUT: for pure virtuals, they need to have a method entry, even though they
# do NOT have a switch code.
return if ( $m->{SkipFromSwitch} && $m->{Flags} !~ "p" );
# No switch code for destructors if we didn't derive from the class (e.g. it has private ctors only)
return if ( $m->{ReturnType} eq '~' && ! ( $classNode->{BindingDerives} and $classNode->{HasPublicDestructor}) );
# Is this sorting really important?
#for my $m (sort {$a->{name} cmp $b->{name}} @{ $self->{$c}{method} }) {
my $methName = $m->{astNodeName};
my $def = $m->{FirstDefaultParam};
$def = scalar(@{ $m->{ParamList} }) unless defined $def;
my $last = scalar(@{ $m->{ParamList} }) - 1;
#print STDERR "writeSmokeDataFile: methods: generating for method $methName, def=$def last=$last\n" if ($debug);
while($last >= ($def-1)) {
last if $last < -1;
my $args = [ @{ $m->{ParamList} }[0..$last] ];
my $sig = methodSignature($m, $last);
#my $methodSig = $classNode->{signature}{$sig}; # Munged signature
#print STDERR "writeSmokeDataFile: methods: sig=$className\::$sig methodSig=$methodSig\n" if ($debug);
#my $methodIndex = $methodidx{$methodSig};
#die "$methodSig" if !defined $methodIndex;
my $methodIndex = $methodidx{$methName};
die "$methName" if !defined $methodIndex;
my $case = $classNode->{case}{$sig};
my $typeEntry = findTypeEntry( $m->{ReturnType} );
my $retTypeIndex = defined $typeEntry ? $typeEntry->{index} : 0;
my $i = 0;
my $t = '';
for my $arg (@$args) {
$t .= ', ' if $i++;
my $typeEntry = findTypeEntry( $arg->{ArgType} );
$t .= defined $typeEntry ? $typeEntry->{index} : 0;
}
my $arglist = $t eq '' ? 0 : $arglist{$t};
die "arglist for $t not found" unless defined $arglist;
if ( $m->{Flags} =~ "p" ) {
# Pure virtuals don't have a {case} number, that's normal
die if defined $case;
$case = -1; # This remains -1, not 0 !
} else {
;
# die "$className\::$methName has no case number for sig=$sig" unless defined $case;
}
my $argcnt = $last + 1;
my $methodFlags = '0';
$methodFlags .= "|Smoke::mf_static" if $m->{Flags} =~ "s";
$methodFlags .= "|Smoke::mf_const" if $m->{Flags} =~ "c"; # useful?? probably not
$methodFlags =~ s/0\|//; # beautify
# print OUT "\t{$classIndex, $methodIndex, $arglist, $argcnt, $methodFlags, $retTypeIndex, $case},\t//$methodCount $className\::$sig";
# print OUT " [pure virtual]" if ( $m->{Flags} =~ "p" ); # explain why $case = -1 ;)
# print OUT "\n";
$allMethods{$className . "::" . $sig} = $methodCount;
$methods[$methodCount] = {
c => $classIndex,
methIndex => $methodIndex,
argcnt => $argcnt,
args => $arglist,
retTypeIndex => $retTypeIndex,
idx => $case
};
$methodCount++;
$last--;
} # while
} # if method
} ); # Method Iter
} ); # Class Iter
# print OUT "};\n\n";
my @protos;
Iter::LocalCompounds( $rootnode, sub {
my $classNode = shift;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
return if $classNode->{NodeType} eq 'namespace';
my $classIndex = $classidx{$className};
print STDERR "writeSmokeDataFile: protos: looking at $className\n" if ($debug);
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $m ) = @_;
if( $m->{NodeType} eq "enum" ) {
foreach my $enum ( @{$m->{ParamList}} ) {
my $enumName = $enum->{ArgName};
my $sig = "$className\::$enumName\()";
my $xmeth = $allMethods{$sig};
die "'Method' for enum $sig not found" unless defined $xmeth;
my $xmethIndex = $methodidx{$enumName};
die "'Method index' for enum $enumName not found" unless defined $xmethIndex;
push @protos, {
methIndex => $xmethIndex,
c => $classIndex,
over => {
$sig => {
sig => $sig,
}
},
meth => $xmeth
};
}
} elsif( $m->{NodeType} eq 'var' ) {
my $name = $m->{astNodeName};
my $fullName = "$className\::$name";
my $sig = "$fullName\()";
my $xmeth = $allMethods{$sig};
die "'Method' for var $sig not found" unless defined $xmeth;
my $xmethIndex = $methodidx{$name};
die "'Method index' for var $name not found" unless defined $xmethIndex;
push @protos, {
methIndex => $xmethIndex,
c => $classIndex,
over => {
$sig => {
sig => $sig,
}
},
meth => $xmeth
};
}
});
for my $p (keys %{ $classNode->{proto} }) {
# For each prototype
my $scratch = { %{ $classNode->{proto}{$p} } }; # sig->method association
# first, grab all the superclass voodoo
for my $supNode (superclass_list($classNode)) {
my $i = $supNode->{proto}{$p};
next unless $i;
for my $k (keys %$i) {
$scratch->{$k} = $i->{$k} unless exists $scratch->{$k};
}
}
# Ok, now we have a full list
#if(scalar keys %$scratch > 1) {
#print STDERR "Overload: $p (@{[keys %$scratch]})\n" if ($debug);
#}
my $xmethIndex = $methodidx{$p};
my $classIndex = $classidx{$className};
for my $sig (keys %$scratch) {
#my $xsig = $scratch->{$sig}{class} . "::" . $sig;
my $xsig = $className . "::" . $sig;
$scratch->{$sig}{sig} = $xsig;
delete $scratch->{$sig}
if $scratch->{$sig}{Flags} =~ "p" # pure virtual
or not exists $allMethods{$xsig};
}
push @protos, {
methIndex => $xmethIndex,
c => $classIndex,
over => $scratch
} if scalar keys %$scratch;
}
});
my @protolist = sort { $a->{c} <=> $b->{c} || $a->{methIndex} <=> $b->{methIndex} } @protos;
#for my $abc (@protos) {
#print "$abc->{methIndex}.$abc->{c}\n";
#}
print STDERR "Writing methodmap table\n" if ($debug);
my @resolve = ();
# print OUT "// Class ID, munged name ID (index into methodNames), method def (see methods) if >0 or number of overloads if <0\n";
my $methodMapCount = 1;
# print OUT "static Smoke::MethodMap ${libname}_methodMaps[] = {\n";
# print OUT "\t{ 0, 0, 0 },\t//0 (no method)\n";
for my $cur (@protolist) {
if(scalar keys %{ $cur->{over} } > 1) {
# print OUT "\t{$cur->{c}, $cur->{methIndex}, -@{[1+scalar @resolve]}},\t//$methodMapCount $classlist[$cur->{c}]\::$methodlist[$cur->{methIndex}]\n";
$methodMapCount++;
for my $k (keys %{ $cur->{over} }) {
my $p = $cur->{over}{$k};
my $xsig = $p->{class} ? "$p->{class}\::$k" : $p->{sig};
push @resolve, { k => $k, p => $p, cur => $cur, id => $allMethods{$xsig} };
}
push @resolve, 0;
} else {
for my $k (keys %{ $cur->{over} }) {
my $p = $cur->{over}{$k};
my $xsig = $p->{class} ? "$p->{class}\::$k" : $p->{sig};
# print OUT "\t{$cur->{c}, $cur->{methIndex}, $allMethods{$xsig}},\t//$methodMapCount $classlist[$cur->{c}]\::$methodlist[$cur->{methIndex}]\n";
$methodMapCount++;
}
}
}
# print OUT "};\n\n";
print STDERR "Writing ambiguousMethodList\n" if ($debug);
# print OUT "static Smoke::Index ${libname}_ambiguousMethodList[] = {\n";
# print OUT " 0,\n";
for my $r (@resolve) {
unless($r) {
# print OUT " 0,\n";
next;
}
my $xsig = $r->{p}{class} ? "$r->{p}{class}\::$r->{k}" : $r->{p}{sig};
die "ambiguousMethodList: no method found for $xsig\n" if !defined $allMethods{$xsig};
# print OUT " $allMethods{$xsig}, // $xsig\n";
}
# print OUT "};\n\n";
# print OUT "extern \"C\" { // needed?\n";
# print OUT " void init_${libname}_Smoke();\n";
# print OUT "}\n";
# print OUT "\n";
# print OUT "Smoke* qt_Smoke = 0L;\n";
# print OUT "\n";
# print OUT "// Create the Smoke instance encapsulating all the above.\n";
# print OUT "void init_${libname}_Smoke() {\n";
# print OUT " qt_Smoke = new Smoke(\n";
# print OUT " ${libname}_classes, ".$#classlist.",\n";
# print OUT " ${libname}_methods, $methodCount,\n";
# print OUT " ${libname}_methodMaps, $methodMapCount,\n";
# print OUT " ${libname}_methodNames, $methodNameCount,\n";
# print OUT " ${libname}_types, $typeCount,\n";
# print OUT " ${libname}_inheritanceList,\n";
# print OUT " ${libname}_argumentList,\n";
# print OUT " ${libname}_ambiguousMethodList,\n";
# print OUT " ${libname}_cast );\n";
# print OUT "}\n";
# close OUT;
#print "@{[keys %allMethods ]}\n";
}
=head2 printJavadocComment
Parameters: docnode filehandle
Converts a kdoc comment to javadoc format.
@ref's are converted to @link's; @p's and @em's are converted
to inline HTML.
=cut
sub printJavadocComment($$$$)
{
my( $docnode, $name, $indent, $signalLink ) = @_;
my $node;
my $returntext = '';
foreach $node ( @{$docnode->{Text}} ) {
next if $node->{NodeType} ne "DocText" and $node->{NodeType} ne "ListItem"
and $node->{NodeType} ne "Param";
my $line = '';
if ($node->{NodeType} eq "Param") {
if ($node->{Name} !~ /argc/) {
$line = "\@param " . $node->{Name} . " " . $node->{astNodeName};
}
} else {
$line = $node->{astNodeName};
}
$line =~ s/argc, ?argv/args/g;
$line =~ s/int argc, ?char ?\* ?argv(\[\])?/String[] args/g;
$line =~ s/int argc, ?char ?\*\* ?argv/String[] args/g;
if ($node->{NodeType} eq "Param") {
$line =~ s/(const )?QC?StringList(\s*&)?/String[]/g;
} else {
$line =~ s/(const )?QC?StringList(\s*&)?/ArrayList/g;
}
$line =~ s/NodeList|KTrader::OfferList/ArrayList/g;
$line =~ s/(const )?TQDate(Time)?(\s*&)?/Calendar/g;
$line =~ s/(const )?TQTime([^r])/Date$1/g;
$line =~ s/TQString::null/null/g;
$line =~ s/(const )?QC?String(\s*&)?/String/g;
$line =~ s/TQByteArray/byte[]/g;
$line =~ s/(const )?KCmdLineOptions\s*(\w+)\[\]/String[][] $2/;
$line =~ s/KCmdLineLastOption//g;
$line =~ s/virtual //g;
$line =~ s/~\w+\(\)((\s*{\s*})|;)//g;
$line =~ s/0L/null/g;
$line =~ s/(\([^\)]*\))\s*:\s*\w+\([^\)]*\)/$1/g;
$line =~ s/\(void\)//g;
$line =~ s/const char/String/g;
$line =~ s/const (\w+)\&/$1/g;
$line =~ s/bool/boolean/g;
$line =~ s/SLOT\(\s*([^\)]*)\) ?\)/SLOT("$1)")/g;
$line =~ s/SIGNAL\(\s*([^\)]*)\) ?\)/SIGNAL("$1)")/g;
$line =~ s/Q_OBJECT\n//g;
$line =~ s/class\s+([\w]+)\s*:\s*public/public class $1 implements/g;
$line =~ s/public\s*(slots)?:\n/public /g;
$line =~ s/([^0-9"]\s*)\*(\s*[^0-9"-])/$1$2/g;
$line =~ s/^(\s*)\*/$1/g;
$line =~ s/\n \*/\n /g;
$line =~ s/\@ref\s+([\w]+)::([\w]+)\s*(\([^\)]*\))(\.)?/{\@link $1#$2}$4/g;
$line =~ s/\@ref\s+#([\w:]+)(\(\))?/{\@link #$1}/g;
$line =~ s/\@ref\s+([\w]+)\s*(\([^\)]*\))/{\@link #$1}/g;
$line =~ s/\@ref\s+([\w]+)::([\w]+)/{\@link $1#$2}/g;
$line =~ s/\@ref\s+([a-z][\w]+)/{\@link #$1}/g;
$line =~ s/\@ref\s+([\w]+)/{\@link $1}/g;
while ($line =~ /\@c\s+([\w#\\\.<>]+)/ ) {
my $code = $1;
$code =~ s!<!&lt;!g;
$code =~ s!>!&gt;!g;
$code =~ s!\\#!#!g;
$line =~ s!\@c\s+([\w#\\\.<>]+)!<code>$code</code>!;
}
$line =~ s!\@em\s+(\w+)!<b>$1</b>!g;
$line =~ s!\@p\s+([\w\._]*)!<code>$1</code>!g;
$line =~ s!\\paragraph\s+[\w]+\s([\w]+)!<li><b>$1</b></li>!g;
$line =~ s!\\b\s+([\w -]+)\\n!<li><b>$1</b></li>!g;
$line =~ s!\\c\s+([\w\@&\\?;-]+)!<code>$1</code>!g;
$line =~ s!\\p\s+([\w\@]+)!<pre>$1</pre>!g;
$line =~ s!\\li\s+([\w\@]+)!<li>$1</li>!g;
$line =~ s!<b>([\w\t \(\)-]*:?)</b>\\n!<li><b>$1</b></li>!g;
$line =~ s!static_cast<\s*([\w\.]*)\s*>!($1)!g;
if ($name ne "") {
$line =~ s/\@link #/\@link $name\#/g;
}
if ($node->{NodeType} eq "ListItem") {
$line =~ s/^/\n<li>\n/;
$line =~ s!$!\n</li>!;
$line =~ s/\n/\n$indent\t/g;
} else {
$line =~ s/^/$indent/;
$line =~ s/\n/\n$indent/g;
}
$line =~ s/\n/\n$indent/g;
$returntext .= $line;
}
$returntext .= $signalLink;
if ( defined $docnode->{Returns} ) {
my $text = $docnode->{Returns};
$text =~ s/TQString::null/null/g;
$returntext .= "\t\t\@return $text\n";
}
if ( defined $docnode->{Author} ) {
$returntext .= "\t\t\@author " . $docnode->{Author} . "\n"
}
if ( defined $docnode->{Version} ) {
my $versionStr = $docnode->{Version};
$versionStr =~ s/\$\s*Id:([^\$]*) Exp \$/$1/;
$returntext .= "\t\t\@version $versionStr\n";
}
if ( defined $docnode->{ClassShort} ) {
my $shortText = $docnode->{ClassShort};
$shortText =~ s![\*\n]! !g;
$returntext .= "\t\t\@short $shortText\n";
}
if ( defined $docnode->{See} ) {
foreach my $text ( @{$docnode->{See}} ) {
next if ($text =~ /TQString|^\s*and\s*$|^\s*$|^[^\w]*$/);
$text =~ s/KIO:://g;
$text =~ s/KParts:://g;
$text =~ s/bool/boolean/g;
$text =~ s/::/#/g;
$text =~ s/->/#/g;
$text =~ s/\./#/g;
$text =~ s/\(\)//g;
$text =~ s/^\s*([a-z].*)/#$1/g;
$text =~ s/^\s*Q/org.kde.qt.Q/g;
# $text =~ s/^\s*K/org.kde.koala.K/g;
$returntext .= "\t\t\@see $text\n";
}
}
$returntext =~ s/DOM#([A-Z])/$1/g;
$returntext =~ s/KIO#([A-Z])/$1/g;
$returntext =~ s/KParts#([A-Z])/$1/g;
$returntext =~ s/const\s+(\w+)\s*\&/$1/g;
$returntext =~ s/TQChar/char/g;
$returntext =~ s/TQStringList/ArrayList/g;
$returntext =~ s/([Aa]) ArrayList/$1n ArrayList/g;
$returntext =~ s/TQString/String/g;
$returntext =~ s/KCmdLineOptions/String[][]/;
$returntext =~ s!\\note!<b>Note:<\b>!g;
$returntext =~ s!\\(code|verbatim)!<pre>!g;
$returntext =~ s!\\(endcode|endverbatim)!</pre>!g;
$returntext =~ s!\\addtogroup\s+[\w]+\s+"([^"\@]+)"\s+\@{!<li><b>$1</b></li>!g;
$returntext =~ s![\\\@]relates\s+([a-z][\w]*)!{\@link #$1}!g;
$returntext =~ s![\\\@]relates\s+(\w+)::(\w+)!{\@link $1#$2}!g;
$returntext =~ s![\\\@]relates\s+(#?\w+)!{\@link $1}!g;
$returntext =~ s!\\c\s+([\w\@&\\?";-]+)!<code>$1</code>!g;
$returntext =~ s!\@p\s+([\w\._]*)!<code>$1</code>!g;
$returntext =~ s!\@a\s+([:\w]+)!<b>$1</b>!g;
$returntext =~ s![\@\\]b\s+[:\w]!<b>$1</b>!g;
$returntext =~ s/};/}/g;
$returntext =~ s/::/./g;
$returntext =~ s/->/./g;
$returntext =~ s/\s*$//;
return $returntext . "\n" . $indent;
}
1;