#*************************************************************************** # kalyptusCxxToSmoke.pm - Generates x_*.cpp files for smoke # ------------------- # begin : Fri Jan 25 12:00:00 2000 # copyright : (C) 2002 Lost Highway Ltd. All Rights Reserved. # email : david@mandrakesoft.com # author : 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 kalyptusCxxToSmoke; use File::Path; use File::Basename; use constant numSourceFiles => 20; # Total number of generated source files. # All classes will be distributed across those. 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 $methodNumber $headerSubdirectories %builtins %typeunion %allMethods %allTypes %enumValueToType %typedeflist %mungedTypeMap %skippedClasses /; 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&' => '$', 'char*' => '$', 'TQCOORD*' => '?', 'TQRgb*' => '?', 'TQ_UINT64' => '$', 'TQ_INT64' => '$', 'TQ_LLONG' => '$', 'tquint64' => '$', 'qint64' => '$', 'long long' => '$', 'qulonglong' => '$', ); # 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', '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*', # 'TQStyleHintReturn*' => '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) 'TQPtrCollection::Item' => 'void*', # to avoid a warning 'void(* )()' => 'void*', 'void (*)(void* )' => 'void*', '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', 'qint16' => 'short', 'TQ_INT32' => 'int', 'qint32' => 'int', 'qint32&' => 'int&', 'TQ_INT8' => 'char', 'qint8' => 'char', 'TQ_LONG' => 'long', 'TQ_UINT16' => 'ushort', 'tquint16' => 'ushort', 'TQ_UINT32' => 'uint', 'tquint32' => 'uint', 'TQ_UINT8' => 'uchar', 'tquint8' => 'uchar', 'TQ_ULONG' => 'long', 'qreal' => 'double', 'pid_t' => 'int', 'size_t' => 'int', 'pid_t' => 'int', 'time_t' => 'int', 'short int' => 'short', 'signed long int' => 'long', 'unsigned long int' => 'ulong', 'unsigned short int' => 'ushort', 'TQt::Alignment' => 'int', 'TQt::Orientations' => 'int', 'TQt::DockWidgetAreas' => 'int', 'TQt::DropActions' => 'int', 'TQt::ImageConversionFlags' => 'int', 'TQt::ItemFlags' => 'int', 'TQt::KeyboardModifiers' => 'int', 'TQt::MatchFlags' => 'int', 'TQt::MouseButtons' => 'int', 'TQt::ToolBarAreas' => 'int', 'TQt::WindowFlags' => 'int', 'TQt::WindowStates' => 'int', 'AutoFormatting' => 'int', 'DirtyFlags' => 'int', 'EditTriggers' => 'int', 'FindFlags' => 'int', 'Flags' => 'int', 'FormattingOptions' => 'int', 'GLenum' => 'int', 'GLint' => 'int', 'GLuint' => 'uint', 'LoadOperator' => 'int', 'NumberFlags' => 'int', 'OpenMode' => 'int', 'Options' => 'int', 'PaintEngineFeatures' => 'int', 'Permissions' => 'int', 'PrintDialogOptions' => 'int', 'ProcessEventsFlags' => 'int', 'TQDir::Filters' => 'int', 'TQDir::SortFlags' => 'int', 'TQFile::Permissions' => 'int', 'TQGL::FormatOptions' => 'int', 'TQIODevice::OpenMode' => 'int', 'TQImageReader::ImageReaderError' => 'int', 'TQItemSelectionModel::SelectionFlags' => 'int', 'TQPaintEngine::DirtyFlags' => 'int', 'TQPainter::RenderHints' => 'int', 'TQSql::ParamType' => 'int', 'TQTextDocument::FindFlags' => 'int', 'Q_PID' => 'int', 'TQt::DropActions' => 'int', 'TQt::ImageConversionFlags' => 'int', 'TQt::ItemFlags' => 'int', 'TQt::KeyboardModifiers' => 'int', 'TQt::MatchFlags' => 'int', 'TQt::MouseButtons' => 'int', 'TQt::ToolBarAreas' => 'int', 'TQt::WindowFlags' => 'int', 'TQt::WindowStates' => 'int', 'RenderFlags' => 'int', 'RenderHints' => 'int', 'SortFlags' => 'int', 'StepEnabled' => 'int', 'Sections' => 'int', 'Filters' => 'int', 'SortFlags' => 'int', 'TQDir::Filters' => 'int', 'TQDir::SortFlags' => 'int', 'TQStyle::State' => 'int', 'TQValidator::State' => 'int', 'TQAbstractSpinBox::StepEnabled' => 'int', 'TQDockWidget::DockWidgetFeatures' => 'int', 'TQStyle::SubControls' => 'int', ); $headerSubdirectories = "tdeio/|tdevelop/|kinterfacedesigner/|kontact/|kate/|tdeparts/|dom/|kabc/|ksettings/|kjs/|tdetexteditor/|tdeprint/|tdesu/|knewstuff/" } 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" ) || $main::qt4 ) { 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 ); } ); print STDERR "Writing smokedata.cpp...\n"; # Write out smokedata.cpp writeSmokeDataFile($rootnode); print STDERR "Writing x_*.cpp...\n"; # Generate x_*cpp file for each class my $numclasses; Iter::LocalCompounds( $rootnode, sub { $numclasses++ } ); my $classperfile = int($numclasses/numSourceFiles); print STDERR "Total number of classes: ". $numclasses ."\n" if $debug; my $nodelist = []; my $currentfile = 1; my $currentclass = 1; Iter::LocalCompounds( $rootnode, sub { push @$nodelist, shift; if(@$nodelist == $classperfile and $currentfile != numSourceFiles) { print STDERR "Calling writeClassDoc for ". (scalar @$nodelist) . " classes\n" if $debug; writeClassDoc( $nodelist ); $currentfile++; $nodelist = [] } if(@$nodelist and $currentclass == $numclasses) { print STDERR "Calling writeClassDoc for remaining ". (scalar @$nodelist) . " classes\n" if $debug; writeClassDoc( $nodelist ) } $currentclass++ }); 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 'TQStringData' || $className eq 'TQLatin1String' || $className eq 'TQTLWExtra' || $className eq 'TQWExtra' || $className eq 'TQBig5Codec' || $className eq 'TQBig5hkscsCodec' || $className eq 'TQPtrCollection' || $className eq 'TQGCache' || $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' || $className eq 'KCmdLineOptions' || # Those are template related $className eq 'TQTSManip' || # cause compiler errors with several gcc versions $className eq 'TQGDict' || $className eq 'TQGList' || $className eq 'TQGArray' || $className eq 'TQGVector' || $className eq 'TQStrIList' || $className eq 'TQStrIVec' || $className eq 'TQBitArray' || $className eq 'TQMapData' || $className eq 'TQMetaEnum::Item' || $className eq 'TQWidgetContainerPlugin' || $className eq 'TQGArray::array_data' || ($className eq 'TQMenuItem' and $main::qt_embedded) || ($className eq 'TQSignal' and $main::qt_embedded) || ($className eq 'TQWSEvent' and $main::qt_embedded) || ($className eq 'TQMetaObjectInit' and $main::qt_embedded) || ($className eq 'TQKoi8Codec' and $main::qt_embedded) || $className eq 'TDEAccelGen' || ($className eq 'TQAbstractUndoItem' and $main::qt4) || ($className eq 'TQAbstractItemDelegate' and $main::qt4) || ($className eq 'TQDebug' and $main::qt4) || ($className eq 'TQNoDebug' and $main::qt4) || ($className eq 'TQObjectData' and $main::qt4) || ($className eq 'TQSysInfo' and $main::qt4) || ($className eq 'TQPNGImageWriter' and $main::qt4) || ($className eq 'TQPNGImagePacker' and $main::qt4) || ($className eq 'TQTextCodec::ConverterState' and $main::qt4) || ($className eq 'TQTextLayout::Selection' and $main::qt4) || ($className eq 'TQTextStreamManipulator' and $main::qt4) || $className eq 'DCOPArg' || $className eq 'DCOPReply' || $className eq 'KBookmarkMenu::DynMenuInfo' || $className eq 'KDE' || $className eq 'KDEDesktopMimeType::Service' || $className eq 'KEntry' || $className eq 'KEntryKey' || $className eq 'TDEGlobalSettings::KMouseSettings' || $className eq 'KMimeType::Format' || $className eq 'KNotifyClient::Instance' || $className eq 'KParts::ComponentFactory' || $className eq 'KParts::Plugin::PluginInfo' || $className eq 'KProtocolInfo::ExtraField' || $className eq 'KXMLGUIClient::StateChange' || $className eq 'KIconTheme' || $className eq 'KEditListBox::CustomEditor' || $className eq 'TDEIO::KBookmarkMenuNSImporter' || $className eq 'KExtendedSocket' || $className eq 'TDESocket' || $className eq 'KPerDomainSettings' || $className eq 'TDEApplicationPropsPlugin' || $className eq 'KOpenWithHandler' || $className eq 'KFileOpenWithHandler' || $className eq 'KBindingPropsPlugin' || $className eq 'KPropsDlgPlugin' || $className eq 'KFileSharePropsPlugin' || $className eq 'KBookmarkMenuNSImporter' || $className eq 'KDevicePropsPlugin' || $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 'TDESharedPixmap' || $className eq 'KLibrary' || $className eq 'KScanDialogFactory' || $className eq 'TDEBufferedIO' || $className eq 'KDictSpellingHighlighter' || $className eq 'KPropertiesDialog' || $className eq 'ProgressItem' || $className eq 'TDEIO::ChmodInfo' || $className eq 'tdehtml::DrawContentsEvent' || # the tdehtml:: classes build, but don't link $className eq 'tdehtml::MouseDoubleClickEvent' || $className eq 'tdehtml::MouseMoveEvent' || $className eq 'tdehtml::MousePressEvent' || $className eq 'tdehtml::MouseReleaseEvent' || $className eq 'tdehtml::MouseEvent' || $className eq 'tdehtml' || $className eq 'KURL::List' || $className eq 'KWin::Info' || $className eq 'TerminalInterface' || $className eq 'TQForeachContainerBase' || # Qt4 $className eq 'TQInputMethodEvent::Attribute' || # Qt4 $className eq 'TQAbstractTextDocumentLayout::PaintContext' || # Qt4 $className eq 'TQAbstractTextDocumentLayout::Selection' || # Qt4 $className eq 'TQBrushData' || # Qt4 $className eq 'TQIPv6Address' || # Qt4 $className eq 'TQImageTextKeyLang' || # Qt4 $className eq 'TQMap' || # Qt4 $className eq 'TQMap::const_iterator' || # Qt4 $className eq 'TQMap::iterator' || # Qt4 $className eq 'TQMapData' || # Qt4 $className eq 'TQMapData::Node' || # Qt4 $className eq 'TQSharedData' || # Qt4 $className eq 'TQPainterPath::Element' || # Qt4 $className eq 'TQThreadStorageData' || # Qt4 $className eq 'TQVFbHeader' || # Qt4 $className eq 'TQStyleOptionQ3DockWindow' || # Qt4 $className eq 'TQStyleOptionQ3ListView' || # Qt4 $className eq 'TQStyleOptionQ3ListViewItem' || # Qt4 $className eq 'TQStyleOptionQ3ListView' || # Qt4 $className eq 'TQUpdateLaterEvent' || # Qt4 $className eq 'TQVFbKeyData' || # Qt4 $className eq 'TQVariant::Handler' || # Qt4 $className eq 'TQVariant::PrivateShared' || # Qt4 $className eq 'TQVectorData' || # Qt4 $className eq 'TQWidgetData' || # Qt4 $className eq 'TQThread' || # Qt4 $className eq 'TQThreadStorage' || # Qt4 $className eq 'TQMutex' || # Qt4 $className eq 'TQMutexLocker' || # Qt4 $className eq 'TQSemaphore' || # Qt4 $className eq 'TQWaitCondition' || # Qt4 $className eq 'TQReadWriteLock' || # Qt4 $className eq 'TQReadLocker' || # Qt4 $className eq 'TQWriteLocker' || $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. # Hack to fix up KLed constructors in KDE 3.1 my $kledAmbiguousConstructor = undef; 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}; (my $classNameWithoutNS = $className) =~ s/^.*:://; if ($theArgType =~ /$classNameWithoutNS\s*\&/) { $hasCopyConstructor = 1; $m->{Flags} .= "x"; $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 'TDECModuleLoader' and $name eq 'errorModule') || ($classNode->{astNodeName} eq 'KDCOPActionProxy' and $name eq 'actions') || ($classNode->{astNodeName} eq 'KEditToolbarWidget' and $name eq 'insertActive') || ($classNode->{astNodeName} eq 'KEditToolbarWidget' and $name eq 'removeActive') || ($classNode->{astNodeName} eq 'KEditToolbarWidget' and $name eq 'moveActive') || ($classNode->{astNodeName} eq 'KFileDialog' and $name eq 'addDirEntry') || ($classNode->{astNodeName} eq 'KFileDialog' and $name eq 'getDirEntry') || ($classNode->{astNodeName} eq 'KFileItem' and $name eq 'extraData') || ($classNode->{astNodeName} eq 'KFileView' and $name eq 'selectionMode') || ($classNode->{astNodeName} eq 'KFind' and $name eq 'KFind' and @{$m->{ParamList}} == 4) || ($classNode->{astNodeName} eq 'TDEGlobalAccel' and $name eq 'setEnabled') || ($classNode->{astNodeName} eq 'KCharsets' and $name eq 'encodingsForLanguage') || ($classNode->{astNodeName} eq 'KInputDialog' and $name eq 'getInteger') || ($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 'TDEToolBar' and $name eq 'enable') || ($classNode->{astNodeName} eq 'TDEAccel' and $name eq 'insert' and @{$m->{ParamList}} == 2) || ($classNode->{astNodeName} eq 'TDEAccel' and $name eq 'autoupdate') || ($classNode->{astNodeName} eq 'TDEAccel' and $name eq 'getAutoUpdate') || ($classNode->{astNodeName} eq 'TDEStdAccel' 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 'TDEInstance' and $name eq 'charsets') || ($classNode->{astNodeName} eq 'TDEInstance' and $name eq 'TDEInstance' 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 'KMD4' and $name eq 'transform') || ($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 'KTabWidget' and $name eq 'hoverCloseButtonDelayed') || ($classNode->{astNodeName} eq 'KTar' and $name eq 'writeFile_impl') || ($classNode->{astNodeName} eq 'KIO' and $name eq 'buildHTMLErrorString') || ($classNode->{astNodeName} eq 'KIO' and $name eq 'pasteClipboard') || ($classNode->{astNodeName} eq 'KIO' and $name eq 'pasteData') || ($classNode->{astNodeName} eq 'KIO' and $name eq 'pasteDataAsync') || ($classNode->{astNodeName} eq 'KIO' and $name eq 'isClipboardEmpty') || ($classNode->{astNodeName} eq 'DCOPRef' and $name eq 'callExt') || ($classNode->{astNodeName} eq 'DCOPRef' and $name eq 'call') || ($classNode->{astNodeName} eq 'DCOPRef' and $name eq 'send') || ($classNode->{astNodeName} eq 'DOM' and $name eq 'operator<<') # Avoid kdbgstream debugging method || ($name eq 'qInitJpegIO' and $main::qt4) || ($name eq 'qInitPngIO' and $main::qt4) || ($name eq 'virtual_hook') || ($name eq 'handle') # Obsolete || ($classNode->{astNodeName} eq 'TQTextStream' and $name eq 'TQTextStream' and @{$m->{ParamList}} == 2 and $m->{ParamList}[0]->{ArgType} eq 'TQString&') # Various methods to skip in Qt/E (Qt 2.3.x) || ($main::qt_embedded && ( ($classNode->{astNodeName} eq 'TQUriDrag' and $name =~ /^decode$|decodeLocalFiles|decodeToUnicodeUris/) || ($classNode->{astNodeName} eq 'TQApplication' and $name =~ /^qwsSetCustomColors|^setArgs$|^winMouseButtonUp|^winFocus|^winMouseButtonUP$|^winVersion$/) || ($classNode->{astNodeName} eq 'TQPrinter' and $name =~ /^setIdle$|^setActive$/) || ($classNode->{astNodeName} eq 'TQDragObject' and $name eq 'dragLink') || ($classNode->{astNodeName} eq 'TQFont' and $name eq 'qwsRenderToDisk') || ($classNode->{astNodeName} eq 'TQFontInfo' and $name eq 'font') || ($classNode->{astNodeName} eq 'TQLineEdit' and $name eq 'getSelection') || ($classNode->{astNodeName} eq 'TQMainWindow' and $name eq 'toolBars') || ($classNode->{astNodeName} eq 'TQMovie' and $name eq 'setDisplayWidget') || ($classNode->{astNodeName} eq 'TQMetaObject' and $name =~ /^new_metaenum_item$|^new_metaaccess$/) || ($classNode->{astNodeName} eq 'TQPainter' and $name eq 'pos') || ($classNode->{astNodeName} eq 'TQPixmap' and $name =~ /^allocCell$|^clut$|^freeCell|^hbm|^isMultiCellPixmap|^multiCellPixmap|^multiCellBitmap|^multiCellHandle|^multiCellOffset|^numCols/) || ($name eq 'handle') || ($name eq 'resetInputContext') || ($name eq 'propagateUpdates') || ($name eq 'bytesPerLine') || ($name eq 'scanLine') || ($name eq 'hPal') || ($name eq 'copyX11Data') || ($name eq 'getX11Data') || ($name eq 'setX11Data') || ($name eq 'realizePal') || ($name eq 'qwsDisplay') || ($name eq 'fixport') || ($name eq 'hack_strrchr') || ($name eq 'hack_strchr') || ($name eq 'hack_strstr') ) ) # 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') || ($main::qt4 && ( ($classNode->{astNodeName} eq 'TQWidgetListItem' and $name eq 'operator=') || ($classNode->{astNodeName} eq 'TQColormap' and $name eq 'operator=') || ($classNode->{astNodeName} eq 'TQListWidget' and $name eq 'setItemPosition') || ($classNode->{astNodeName} eq 'TQFontMetricsF' and $name eq 'operator=') || ($classNode->{astNodeName} eq 'TQFontMetricsF' and $name eq 'TQFontMetricsF' and $#{$m->{ParamList}} == 0 && $m->{ParamList}[0]->{ArgType} eq 'const TQFontMetrics&') || ($classNode->{astNodeName} eq 'TQHttp' and $name eq 'supportedOperations') || ($classNode->{astNodeName} eq 'TQRectF' and $name eq 'setX') || ($classNode->{astNodeName} eq 'TQRectF' and $name eq 'setY') || ($classNode->{astNodeName} eq 'TQTextObject' and $name eq 'formatType') || ($classNode->{astNodeName} eq 'TQUrl' and $name eq 'TQUrl' and $#{$m->{ParamList}} == 0 && $m->{ParamList}[0]->{ArgType} eq 'TQUrlPrivate&') || ($classNode->{astNodeName} eq 'TQGlobalSpace' and $name eq 'operator<<' and $m->{ParamList}[0]->{ArgType} =~ /TQDebug/) || ($classNode->{astNodeName} eq 'TQGlobalSpace' and $#{$m->{ParamList}} > 0 and $name =~ /operator/ and $m->{ParamList}[1]->{ArgType} =~ /TQVariant::Type/) || ($#{$m->{ParamList}} > 0 and $m->{ParamList}[0]->{ArgType} =~ /Private/) || ($classNode->{astNodeName} eq 'TQScrollArea' and $name eq 'alignment') || ($classNode->{astNodeName} eq 'TQScrollArea' and $name eq 'setAlignment') || ($m->{ReturnType} =~ /QT3_SUPPORT/) ) ) || $m->{Deprecated} ) { $m->{NodeType} = 'deleted'; next; } # Hack for fixing up KDE 3.1 KLed where the no arg constructor was ambiguous if ($classNode->{astNodeName} eq 'KLed' and $name eq 'KLed' && $#{$m->{ParamList}} > 0) { if ($m->{ParamList}[0]->{ArgType} =~ /TQColor/ && defined $m->{ParamList}[0]->{DefaultValue}) { $m->{ParamList}[0]->{DefaultValue} = undef; if (defined $kledAmbiguousConstructor) { $kledAmbiguousConstructor->{ParamList}[0]->{DefaultValue} = undef; $kledAmbiguousConstructor->{FirstDefaultParam} = 1; } } else { $kledAmbiguousConstructor = $m; } } 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&' # or $arg->{ArgType} =~ /Node\s*\*/ # ) { $m->{NodeType} = 'deleted'; } else { # Resolve type in full, e.g. for TQSessionManager::RestartHint # (x_QSessionManager 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" ) { 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'; # Define a type for this enum registerType( $fullEnumName ); # Remember that it's an enum findTypeEntry( $fullEnumName )->{isEnum} = 1; #print STDERR "$fullEnumName is an enum\n"; } elsif( $m->{NodeType} eq 'var' ) { if ( ($classNode->{astNodeName} eq 'TQUuid' and $name eq 'data4') || ($name eq 'd') || ($classNode->{astNodeName} eq 'SlaveBase' and $name eq 'mIncomingMetaData') || ($classNode->{astNodeName} eq 'SlaveBase' and $name eq 'mOutgoingMetaData') ) { $m->{NodeType} = 'deleted'; next; } my $varType = $m->{Type}; $varType =~ s/const\s+(.*)\s*&/$1/; $varType =~ s/^\s*//; $varType =~ s/\s*$//; $varType =~ s/static\s+//; if ( $m->{Flags} =~ "s" ) { # We are interested in public static vars, like TQColor::blue if ( $m->{Access} ne 'private' && $className."::".$m->{astNodeName} ne "KSpell::modalListText" ) { print STDERR "var: $m->{astNodeName} '$varType'\n" if ($debug); # Register the type registerType( $varType ); } else { $m->{NodeType} = 'deleted'; } } elsif ($m->{Access} eq 'public') { # Add a setter method for a public instance variable my $setMethod = $name; if ($setMethod =~ /^(\w)(.*)/) { my $ch = $1; $ch =~ tr/a-z/A-Z/; $setMethod = "set$ch$2"; } my $node = Ast::New( $setMethod ); $node->AddProp( "NodeType", "method" ); # Flags of "=" for a setter method $node->AddProp( "Flags", "=" ); $node->AddProp( "ReturnType", "void" ); $node->AddProp( "Params", $varType ); my $param = Ast::New( 1 ); $param->AddProp( "NodeType", "param" ); $param->AddProp( "ArgType", $varType ); $node->AddPropList( "ParamList", $param ); kdocAstUtil::attachChild( $classNode, $node ); # Register the type registerType( $varType ); } else { $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); my $isGlobalSpace = ($className eq $main::globalSpaceClassName); # Note that if the class has _no_ constructor, the default ctor applies. Let's even generate it. if ( !$constructorCount && $defaultConstructor eq 'none' && !$hasPrivatePureVirtual && !$isGlobalSpace && $classNode->{NodeType} ne 'namespace' ) { # 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 && !$isGlobalSpace && $classNode->{NodeType} ne 'namespace' ) { 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 ); # 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 x_ 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", "ix" ); # Only for internal use in marshallers 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 series of classes to be written out =cut BEGIN { my $fhn =1; # static sub writeClassDoc { my $nodelist = shift; my $file = "$outputdir/x_${fhn}.cpp"; open( my $fh, ">$file" ) || die "Couldn't create $file\n"; print $fh "//Auto-generated by $0. DO NOT EDIT.\n"; print $fh "#include \n"; print $fh "#include <${libname}_smoke.h>\n"; my @code; for my $node ( @$nodelist ) { push @code, [generateAllMethods( $node )] } my %includes; map { for my $incl (keys %{$_->[2]}){ $includes{$incl}++ } } @code; # Hack - some Qt/KDE headers need other headers included, but omit suitable #includes if (defined $includes{"qregexp.h"} || defined $includes{"qcstring.h"}) { print $fh "#include \n"; delete $includes{"qregexp.h"}; } if (defined $includes{"qmime.h"}) { print $fh "#include \n"; delete $includes{"qurl.h"}; } if (defined $includes{"tdeshortcut.h"}) { print $fh "#include \n"; delete $includes{"tdeshortcut.h"}; } if (defined $includes{"tdeshortcutlist.h"}) { print $fh "#include \n"; print $fh "#include \n"; delete $includes{"tdeconfigbase.h"}; delete $includes{"tdeshortcutlist.h"}; } if (defined $includes{"tdeaction.h"}) { print $fh "#include \n"; delete $includes{"tdeaction.h"}; } foreach my $incl (keys %includes) { die if $incl eq ''; print $fh "#include <$incl>\n"; } if ( $main::qt4 and ( defined $includes{"qtreewidget.h"} or defined $includes{"qlistwidget.h"} or defined $includes{"qtablewidget.h"} ) ) { print $fh "#include \"qwidgetitemdata_p.h\"\n"; } print $fh "\n"; for my $c( 0..$#code ) { my ($methodCode, $switchCode, $incl) = @{ $code[$c] }; my $node = $$nodelist[$c]; my $className = join( "::", kdocAstUtil::heritage($node) ); my $legacyClassName = join( "__", kdocAstUtil::heritage($node) ); print $fh "class x_$legacyClassName "; print $fh ": public $className " if $node->{BindingDerives}; print $fh "{\n"; print $fh $methodCode; print $fh "};\n"; if(keys %{$node->{enumerations}}) { print $fh "void xenum_${legacyClassName}(Smoke::EnumOperation xop, Smoke::Index xtype, void *&xdata, long &xvalue) {\n"; print $fh " x_${legacyClassName}\::xenum_operation(xop, xtype, xdata, xvalue);\n"; print $fh "}\n"; } print $fh "void xcall_${legacyClassName}(Smoke::Index xi, void *obj, Smoke::Stack args) {\n"; print $fh $switchCode; print $fh "}\n\n"; } #if ( $className =~ /^(TQBrush|TQColor|TQCursor|TQFont|TQImage|TQPalette|TQPixmap|TQPoint|TQPointArray|TQRect|TQRegion|TQSize|TQWMatrix)$/ ) { # print XCPPFILE " const char *{serial} operator << () const : pig_serialize(\$this);\n"; # print XCPPFILE " void operator >> (const char *{serial}) : pig_deserialize(\$this, \$1);\n"; #} close $fh; $fhn++ } } # 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; } 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 ); $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 ); $unionfield =~ s/t_/s_/; $type =~ s/\s+const$//; # for 'char* const' $type =~ s/\s+const\s*\*$/\*/; # for 'char* const*' my $v .= "x[$i].$unionfield"; if($type =~ s/&$//) { $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, "$cast$v"; $i++; } return @castedList; } # Adds the header for node $1 to be included in $2 if not already there # Prints out debug stuff if $3 sub addIncludeForClass($$$) { my ( $node, $addInclude, $debugMe ) = @_; my $sourcename = $node->{Source}->{astNodeName}; if ( $sourcename !~ s!.*($headerSubdirectories)(.*)!$1$2!m ) { $sourcename =~ s!.*/(.*)!$1!m; } # die "Empty source name for $node->{astNodeName}" if ( $sourcename eq '' ); return if ( $sourcename eq '' ); unless ( defined $addInclude->{$sourcename} ) { print " Including $sourcename\n" if ($debugMe); $addInclude->{$sourcename} = 1; } else { print " $sourcename already included.\n" if ($debugMe); } } sub checkIncludesForObject($$) { my $type = shift; my $addInclude = shift; my $debugCI = 0; #$debug #print "checkIncludesForObject $type\n"; $type =~ s/const\s+//; my $it = $type; if (!($it and exists $typeunion{$it}) and $type !~ /\*/ #and $type !~ /&/ # in fact we also want refs, due to the generated code ) { $type =~ s/&//; print " Detecting an object by value/ref: $type\n" if ($debugCI); my $node = kdocAstUtil::findRef( $rootnode, $type ); if ($node) { addIncludeForClass( $node, $addInclude, $debugCI ); } else { print " No header 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, $addInclude ) = @_; 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 checkIncludesForObject( $returnType, $addInclude ) if ($returnType ne 'void'); # Generate a matching virtual method in the x_ class $methodCode .= " virtual $returnType $m->{astNodeName}("; my $i = 0; foreach my $arg ( @argList ) { $methodCode .= ", " if $i++; $methodCode .= $arg->{ArgType}; $methodCode .= " x$i"; # Detect objects passed by value checkIncludesForObject( $arg->{ArgType}, $addInclude ); } $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}; if ( ! defined $idx ) { my $class_name = join( "::", kdocAstUtil::heritage($methodClass) ); $sig = $class_name . "::" . $signature; $idx = $allMethods{$sig}; } die "generateVirtualMethod: $className: No method found for $sig\n" if !defined $idx; 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 = applyTypeDef( $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 .= " }\n"; return ( $methodCode ); } sub generateMethod($$$) { my( $classNode, $m, $addInclude ) = @_; # input my $methodCode = ''; # output my $switchCode = ''; # output my $name = $m->{astNodeName}; # method name my @heritage = kdocAstUtil::heritage($classNode); my $className = join( "::", @heritage ); my $xClassName = "x_" . join( "__", @heritage ); # Check some method flags: constructor, destructor etc. my $flags = $m->{Flags}; if ( !defined $flags ) { warn "Method ".$name. " has no flags\n"; } my $returnType = $m->{ReturnType}; $returnType = undef if ($returnType eq 'void'); # 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 '~'); if ($debug) { print STDERR " Method $name"; print STDERR ", is DTOR" if $isDestructor; print STDERR ", returns $returnType" if $returnType; #print STDERR " ($m->{Access})"; print STDERR "\n"; } # Don't generate anything for destructors return if $isDestructor; return if ( $m->{SkipFromSwitch} ); # pure virtuals, etc. # # 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"; # Detect objects returned by value checkIncludesForObject( $returnType, $addInclude ) if ($returnType); my $argId = 0; my @argTypeList=(); foreach my $arg ( @{$m->{ParamList}} ) { print STDERR " Param ".$arg->{astNodeName}." type: ".$arg->{ArgType}." name:".$arg->{ArgName}." default: ".$arg->{DefaultValue}."\n" if ($debug); my $argType = $arg->{ArgType}; push @argTypeList, $argType; # Detect objects passed by value checkIncludesForObject( $argType, $addInclude ); } my @castedArgList = makeCastedArgList( @argTypeList ); my $isStatic = $flags =~ "s"; my $extra = ""; $extra .= "static " if $isStatic || $isConstructor || $classNode->{NodeType} eq 'namespace'; my $attr = ""; $attr .= "const " if $flags =~ "c"; my $this = $classNode->{BindingDerives} > 0 ? "this" : "xthis"; # 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 $xretCode = ''; if($returnType) { $xretCode .= coerce_type('x[0]', 'xret', $returnType, 1); } print STDERR " ". ($iterationCount+1). " iterations for $name\n" if ($debug); while($iterationCount >= 0) { local($") = ","; # Handle case of a class with constructors, but with a private pure virtual # so we can't create an instance of it if($isConstructor and !$classNode->{CanBeInstanciated}) { # We still generate "forwarder constructors" for x_className though $methodCode .= " $xClassName("; my $i = 0; for my $arg (@argTypeList) { $methodCode .= ", " if $i++; $methodCode .= "$arg x$i"; } $methodCode .= ") : $className("; $i = 0; for my $arg (@argTypeList) { $methodCode .= ", " if $i++; $methodCode .= "x$i"; } $methodCode .= ") {}\n"; } else { $switchCode .= "\tcase $methodNumber: "; if ($flags =~ "s" || $isConstructor || $classNode->{NodeType} eq 'namespace') { # static, namespace or constructor $switchCode .= "$xClassName\::"; } else { $switchCode .= "xself->" } $switchCode .= "x_$methodNumber(args);"; $switchCode .= "\tbreak;\n"; $methodCode .= " ${extra}void x_$methodNumber\(Smoke::Stack x) $attr\{\n"; my $cplusplusparams = join( ", ", @argTypeList ); $methodCode .= "\t// $name($cplusplusparams)\n"; $methodCode .= "\t"; if ($isConstructor) { $methodCode .= "$xClassName* xret = new $xClassName(@castedArgList[0..$#argTypeList]);\n"; #$m->{retnew} = 1; $methodCode .= "\tx[0].s_class = (void*)xret;\n"; # the return value, containing the new object $methodCode .= " }\n"; # Now generate the actual constructor for x_className # (Simply a forwarder to the className constructor with the same args if ( $flags =~ "t" ) { $methodCode .= " explicit $xClassName("; } else { $methodCode .= " $xClassName("; } my $i = 0; for my $arg (@argTypeList) { $methodCode .= ", " if $i++; if ($arg =~ s/\(\*\)/(* x$i)/) { # function pointer... need to insert argname inside $methodCode .= $arg; } else { $methodCode .= "$arg x$i"; } } $methodCode .= ") : $className("; $i = 0; for my $arg (@argTypeList) { $methodCode .= ", " if $i++; $methodCode .= "x$i"; } $methodCode .= ") {\n"; } else { $methodCode .= $returnType . " xret = " if $returnType; $methodCode .= "$this\->" unless $isStatic || $classNode->{NodeType} eq 'namespace'; if ($className ne $main::globalSpaceClassName) { if ($flags =~ "=") { # Setter method for a public instance variable my $varName = $name; $varName =~ /^set(\w)(.*)/; my $ch = $1; $ch =~ tr/A-Z/a-z/; $varName = $ch . $2; $methodCode .= "$varName = @castedArgList[0..$#argTypeList];\n"; } else { $methodCode .= "$className\::$name(@castedArgList[0..$#argTypeList]);\n"; } } elsif ($name =~ /^operator\s?\W+/) { ( my $op = $name ) =~ s/^operator(.*)$/$1/; if (scalar(@argTypeList) == 2) { if( $name =~ /^operator(?:\+\+|--)/ ) { # postfix increment/decrement $methodCode .= "(@castedArgList[0])$op;\n"; } else { $methodCode .= "(@castedArgList[0] $op @castedArgList[1]);\n"; # a + b } } elsif (scalar(@argTypeList) == 1) { $methodCode .= "$op(@castedArgList[0]);\n"; # -a } else { die "shouldn't reach here!"; } } else { $methodCode .= "$name(@castedArgList[0..$#argTypeList]);\n"; } $methodCode .= "\t" . $xretCode if $returnType; # To avoid unused parameter warning, add this to void methods: $methodCode .= "\t(void)x; // noop (for compiler warning)\n" unless $returnType; } $methodCode .= " }\n"; } pop @argTypeList; $methodNumber++; $iterationCount--; } # Iteration loop return ( $methodCode, $switchCode ); } sub generateEnum($$$) { my( $classNode, $m, $addInclude ) = @_; # input my $methodCode = ''; # output my $switchCode = ''; # output my @heritage = kdocAstUtil::heritage($classNode); my $className = join( "::", @heritage ); my $xClassName = "x_" . join( "__", @heritage ); my $fullEnumType = "$className\::". $m->{astNodeName}; checkIncludesForObject( $fullEnumType, $addInclude ); foreach my $enum ( @{$m->{ParamList}} ) { my $enumName = $enum->{ArgName}; my $fullEnumName = "$className\::$enumName"; die "Invalid index for $fullEnumName: $classNode->{case}{$fullEnumName} instead of $methodNumber" if $classNode->{case}{$fullEnumName} != $methodNumber; $methodCode .= " static void x_$methodNumber(Smoke::Stack x) {\n"; $methodCode .= "\tx[0].s_enum = (long)$fullEnumName;\n"; $methodCode .= " }\n"; $switchCode .= "\tcase $methodNumber: $xClassName\::x_$methodNumber(args);\tbreak;\n"; $methodNumber++; } return ( $methodCode, $switchCode ); } sub generateVar($$$) { my( $classNode, $m, $addInclude ) = @_; # input my $methodCode = ''; # output my $switchCode = ''; # output my @heritage = kdocAstUtil::heritage($classNode); my $className = join( "::", @heritage ); my $xClassName = "x_" . join( "__", @heritage ); 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"; my $this = $classNode->{BindingDerives} > 0 ? "this" : "xthis"; checkIncludesForObject( $varType, $addInclude ); die "Invalid index for $fullName: $classNode->{case}{$fullName} instead of $methodNumber" if $classNode->{case}{$fullName} != $methodNumber; if ( $m->{Flags} =~ "s" ) { $methodCode .= " static void x_$methodNumber(Smoke::Stack x) {\n "; $methodCode .= coerce_type('x[0]', $fullName, $varType, 1); $methodCode .= " }\n"; $switchCode .= "\tcase $methodNumber: $xClassName\::x_$methodNumber(args);\tbreak;\n"; } else { $methodCode .= " void x_$methodNumber(Smoke::Stack x) {\n "; $methodCode .= coerce_type('x[0]', "$this->$name", $varType, 1); $methodCode .= " }\n"; $switchCode .= "\tcase $methodNumber: xself->x_$methodNumber(args);\tbreak;\n"; } $methodNumber++; return ( $methodCode, $switchCode ); } sub generateEnumCast($) { my( $classNode ) = @_; my $methodCode = ''; return unless keys %{$classNode->{enumerations}}; $methodCode .= " static void xenum_operation(Smoke::EnumOperation xop, Smoke::Index xtype, void *&xdata, long &xvalue) {\n"; $methodCode .= "\tswitch(xtype) {\n"; for my $enum (values %{$classNode->{enumerations}}) { # Hack - this shouldn't be needed here - deprecated enums next if ($enum eq 'KStatusBar::BarStatus' or $enum eq 'KMdi::AddWindowFlags' or $enum eq 'TDEToolBar::BarStatus' or $enum eq 'KMimeType::Format:: compression : 4'); my $type = findTypeEntry($enum); $methodCode .= "\t case $type->{index}: //$enum\n"; $methodCode .= "\t switch(xop) {\n"; $methodCode .= "\t case Smoke::EnumNew:\n"; $methodCode .= "\t\txdata = (void*)new $enum;\n"; $methodCode .= "\t\tbreak;\n"; $methodCode .= "\t case Smoke::EnumDelete:\n"; # unnecessary $methodCode .= "\t\tdelete ($enum*)xdata;\n"; $methodCode .= "\t\tbreak;\n"; $methodCode .= "\t case Smoke::EnumFromLong:\n"; $methodCode .= "\t\t*($enum*)xdata = ($enum)xvalue;\n"; $methodCode .= "\t\tbreak;\n"; $methodCode .= "\t case Smoke::EnumToLong:\n"; $methodCode .= "\t\txvalue = (long)*($enum*)xdata;\n"; $methodCode .= "\t\tbreak;\n"; $methodCode .= "\t }\n"; $methodCode .= "\t break;\n"; } $methodCode .= "\t}\n"; $methodCode .= " }\n"; return $methodCode; } ## Called by writeClassDoc sub generateAllMethods { my ($classNode) = @_; my $methodCode = ''; my $switchCode = ''; $methodNumber = 0; #my $className = $classNode->{astNodeName}; my $className = join( "::", kdocAstUtil::heritage($classNode) ); my $xClassName = "x_" . join( "__", kdocAstUtil::heritage($classNode) ); my $isGlobalSpace = ($xClassName eq ("x_".$main::globalSpaceClassName)); my $sourcename = $classNode->{Source}->{astNodeName}; if ( $sourcename !~ s!.*($headerSubdirectories)(.*)!$1$2!m ) { $sourcename =~ s!.*/(.*)!$1!m; } die "Empty source name for $classNode->{astNodeName}" if ( $sourcename eq '' ); my %addInclude = ( $sourcename => 1 ); if (!$isGlobalSpace) { if($classNode->{NodeType} eq 'namespace') { $switchCode .= " (void)obj;\n"; $methodCode .= "public:\n"; my $s; for my $sn( @{$classNode->{Sources}} ) { if ( ($s = $sn->{astNodeName}) !~ s!.*($headerSubdirectories)(.*)!$1$2!m ) { $s =~ s!.*/(.*)!$1!m; } $addInclude{ $s } = 1; } } elsif(! $classNode->{BindingDerives}) { $methodCode .= "private:\n"; $methodCode .= " $className *xthis;\n"; $methodCode .= "public:\n"; $methodCode .= " $xClassName\(void *x) : xthis(($className*)x) {}\n"; $switchCode .= " $xClassName xtmp(obj), *xself = &xtmp;\n"; } else { $switchCode .= " $xClassName *xself = ($xClassName*)obj;\n"; $methodCode .= "public:\n"; } } else { my $s; for my $sn( @{$classNode->{Sources}} ) { if ( ($s = $sn->{astNodeName}) !~ s!.*($headerSubdirectories)(.*)!$1$2!m ) { $s =~ s!.*/(.*)!$1!m; } $addInclude{ $s } = 1; } $methodCode .= "public:\n"; $switchCode .= " (void) obj;\n"; } $switchCode .= " switch(xi) {\n"; # Do all enums first Iter::MembersByType ( $classNode, undef, sub { my ($classNode, $methodNode ) = @_; if ( $methodNode->{NodeType} eq 'enum' ) { my ($meth, $swit) = generateEnum( $classNode, $methodNode, \%addInclude ); $methodCode .= $meth; $switchCode .= $swit; } }, undef ); # Then all static vars Iter::MembersByType ( $classNode, undef, sub { my ($classNode, $methodNode ) = @_; if ( $methodNode->{NodeType} eq 'var' ) { my ($meth, $swit) = generateVar( $classNode, $methodNode, \%addInclude ); $methodCode .= $meth; $switchCode .= $swit; } }, undef ); # Then all methods Iter::MembersByType ( $classNode, undef, sub { my ($classNode, $methodNode ) = @_; if ( $methodNode->{NodeType} eq 'method' ) { my ($meth, $swit) = generateMethod( $classNode, $methodNode, \%addInclude ); $methodCode .= $meth; $switchCode .= $swit; } }, 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}, \%addInclude ); $methodCode .= $meth; } } $methodCode .= generateEnumCast( $classNode ); # 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 ~$xClassName() {}\n"; #} # We generate a dtor though, because we might want to add stuff into it if ( !$isGlobalSpace && $classNode->{NodeType} ne 'namespace' ) { $methodCode .= " ~$xClassName() { ${libname}_Smoke->binding->deleted($classNode->{ClassIndex}, (void*)this); }\n"; } if ($classNode->{CanBeInstanciated} and $classNode->{HasPublicDestructor}) { die "$className destructor: methodNumber=$methodNumber != case entry=".$classNode->{case}{"~$className()"}."\n" if $methodNumber != $classNode->{case}{"~$className()"}; $switchCode .= "\tcase $methodNumber: delete ($className*)xself;\tbreak;\n"; $methodNumber++; } $switchCode .= " }\n"; return ( $methodCode, $switchCode, \%addInclude ); } # 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*' $type =~ s/(<[^>]*)\s+([^>]*>)/$1$2/; # Remove embedded space from template types, such as # 'TQMap' 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 TQ_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*' $type =~ s/(<[^>]*)\s+([^>]*>)/$1$2/; # Remove embedded space from template types, such as # 'TQMap' 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 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; } # 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 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 ); my %const_methods = (); # Now look at all const methods for this class, in order to use # them in preference to any otherwise identical non-const method Iter::MembersByType ( $classNode, undef, sub { my ($classNode, $m ) = @_; next unless $m->{NodeType} eq 'method'; my @args = @{ $m->{ParamList} }; my $sig = methodSignature( $m, $#args ); if ( $sig =~ /(.*) const$/ ) { $const_methods{$1} = 1; } }, 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 $sig = methodSignature( $m, $#args ); if ( $const_methods{$sig} && $m->{Flags} !~ "v" ) { # If there is a method which just differs from another by 'constness', # then ignore the non-const version $m->{SkipFromSwitch} = 1; next; } my $last = $m->{FirstDefaultParam}; $last = scalar @args unless defined $last; my $iterationCount = scalar(@args) - $last; while($iterationCount >= 0) { $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); } } =head2 Write out the smokedata.cpp file containing all the arrays. =cut sub writeSmokeDataFile($) { my $rootnode = shift; # Make list of classes my %allIncludes; # 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) ); push @classlist, $className; $enumclasslist{$className}++ if keys %{$classNode->{enumerations}}; $classNode->{ClassIndex} = $#classlist; addIncludeForClass( $classNode, \%allIncludes, 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 $incl eq ''; if( $incl eq "kxmlguifactory.h" ) { print OUT "#include \n"; } print OUT "#include <$incl>\n"; } print OUT "\n"; print OUT "#include \n\n"; print OUT "#include \n\n"; # gcc optimizes this method like crazy. switch() is godly print OUT "static void *${libname}_cast(void *xptr, Smoke::Index from, Smoke::Index to) {\n"; print OUT " switch(from) {\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 if (!defined $s) { die "problem with $className missing parent" } 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) ); 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) ); 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}; die "problem with $className" unless defined $classinherit{$className}; 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{$className}, $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 =~ /\(/; if ($realType =~ /\(/) { print "FATAL ERROR $type $realType\n"; } # 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 =~ / 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 $numTypes = scalar(split ',', $args); 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 + 1; # 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) ); 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|Smoke::mf_enum, $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}; if ( $m->{Flags} =~ "s" ) { print OUT "\t{$classIndex, $xmethIndex, 0, 0, Smoke::mf_static, $typeId, $classNode->{case}{$fullName}},\t//$methodCount $fullName (static var)\n"; } else { print OUT "\t{$classIndex, $xmethIndex, 0, 0, 0, $typeId, $classNode->{case}{$fullName}},\t//$methodCount $fullName (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'; # Make no distinction between a static method in an ordinary class, or a method in a namespace $methodFlags .= "|Smoke::mf_static" if $m->{Flags} =~ "s" or $classNode->{NodeType} eq 'namespace'; $methodFlags .= "|Smoke::mf_const" if $m->{Flags} =~ "c"; # useful?? probably not $methodFlags .= "|Smoke::mf_copyctor" if $m->{Flags} =~ "x"; $methodFlags .= "|Smoke::mf_internal" if $m->{Flags} =~ "i"; $methodFlags .= "|Smoke::mf_ctor" if $methName eq $className; $methodFlags .= "|Smoke::mf_dtor" if $m->{ReturnType} eq '~'; $methodFlags .= "|Smoke::mf_protected" if $m->{Access} =~ /protected/; $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) ); 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"; } 1;