#***************************************************************************
# 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' ,
'TQ_INT16' = > 'short' ,
'TQ_INT32' = > 'int' ,
'TQ_INT64' = > 'long' ,
'TQ_INT8' = > 'char' ,
'TQ_LONG' = > 'long' ,
'TQ_LLONG' = > 'long' ,
'TQ_ULLONG' = > 'long' ,
'TQ_UINT16' = > 'ushort' ,
'TQ_UINT32' = > 'uint' ,
'TQ_UINT64' = > 'long' ,
'TQ_UINT8' = > 'uchar' ,
'TQ_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!<!<!g ;
$ code =~ s!>!>!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 ;