summaryrefslogtreecommitdiffstats
path: root/dcop/dcopidlng/kalyptus
diff options
context:
space:
mode:
Diffstat (limited to 'dcop/dcopidlng/kalyptus')
-rw-r--r--dcop/dcopidlng/kalyptus1612
1 files changed, 1612 insertions, 0 deletions
diff --git a/dcop/dcopidlng/kalyptus b/dcop/dcopidlng/kalyptus
new file mode 100644
index 000000000..9a3709fc0
--- /dev/null
+++ b/dcop/dcopidlng/kalyptus
@@ -0,0 +1,1612 @@
+#!/usr/bin/perl -I/Users/duke/src/kde/kdebindings/kalyptus
+# -*- indent-tabs-mode: t; c-basic-offset: 4; tab-width: 4 -*-
+
+# KDOC -- C++ and CORBA IDL interface documentation tool.
+# Sirtaj Singh Kang <taj@kde.org>, Jan 1999.
+# $Id$
+
+# All files in this project are distributed under the GNU General
+# Public License. This is Free Software.
+
+require 5.000;
+
+use Carp;
+use Getopt::Long;
+use File::Basename;
+use strict;
+
+use Ast;
+
+use kdocUtil;
+use kdocAstUtil;
+use kdocParseDoc;
+
+use vars qw/ %rootNodes $declNodeType @includes_list %options @formats_wanted $allow_k_dcop_accessors
+ $skipInternal %defines $defines $match_qt_defines
+ $libname $outputdir $parse_global_space $striphpath $doPrivate $readstdin
+ $Version $quiet $debug $debuggen $parseonly $currentfile $cSourceNode $exe
+ %formats %flagnames @allowed_k_dcop_accesors $allowed_k_dcop_accesors_re $rootNode
+ @classStack $cNode $globalSpaceClassName
+ $lastLine $docNode @includes $cpp $defcppcmd $cppcmd $docincluded
+ $inExtern $inNamespace %stats %definitions @inputqueue @codeqobject /;
+
+## globals
+
+%rootNodes = (); # root nodes for each file type
+$declNodeType = undef; # last declaration type
+
+@includes_list = (); # list of files included from the parsed .h
+
+# All options
+
+%options = (); # hash of options (set getopt below)
+@formats_wanted = ();
+
+$libname = "";
+$outputdir = ".";
+
+$striphpath = 0;
+
+$doPrivate = 0;
+$Version = "0.9";
+
+$quiet = 0;
+$debug = 0;
+$debuggen = 0;
+$parseonly = 0;
+$globalSpaceClassName = "QGlobalSpace";
+
+$currentfile = "";
+
+$cpp = 0;
+$defcppcmd = "g++ -Wp,-C -E";
+$cppcmd = "";
+
+$exe = basename $0;
+
+@inputqueue = ();
+@codeqobject = split "\n", <<CODE;
+public:
+ virtual QMetaObject *metaObject() const;
+ virtual const char *className() const;
+ virtual void* qt_cast( const char* );
+ virtual bool qt_invoke( int, QUObject* );
+ virtual bool qt_emit( int, QUObject* );
+ virtual bool qt_property( int, int, QVariant* );
+ static QMetaObject* staticMetaObject();
+ QObject* qObject();
+ static QString tr( const char *, const char * = 0 );
+ static QString trUtf8( const char *, const char * = 0 );
+private:
+CODE
+
+# Supported formats
+%formats = ( "dcopidl" => "kalyptusCxxToDcopIDL" );
+
+# these are for expansion of method flags
+%flagnames = ( v => 'virtual', 's' => 'static', p => 'pure',
+ c => 'const', l => 'slot', i => 'inline', n => 'signal',
+ d => 'k_dcop', z => 'k_dcop_signals', y => 'k_dcop_hidden' );
+
+@allowed_k_dcop_accesors = qw(k_dcop k_dcop_hidden k_dcop_signals);
+$allowed_k_dcop_accesors_re = join("|", @allowed_k_dcop_accesors);
+
+%definitions = {
+ _STYLE_CDE => '',
+ _STYLE_MOTIF => '',
+ _STYLE_MOTIF_PLUS => '',
+ PLUS => '',
+ _STYLE_PLATINUM => '',
+ _STYLE_SGI => '',
+ _STYLE_WINDOWS => '',
+ QT_STATIC_CONST => 'static const',
+ Q_EXPORT => '',
+ Q_REFCOUNT => '',
+ QM_EXPORT_CANVAS => '',
+ QM_EXPORT_DNS => '',
+ QM_EXPORT_ICONVIEW => '',
+ QM_EXPORT_NETWORK => '',
+ QM_EXPORT_SQL => '',
+ QM_EXPORT_WORKSPACE => '',
+ QT_NO_REMOTE => 'QT_NO_REMOTE',
+ QT_ACCESSIBILITY_SUPPORT => 'QT_ACCESSIBILITY_SUPPORT',
+ Q_WS_X11 => 'Q_WS_X11',
+ Q_DISABLE_COPY => 'Q_DISABLE_COPY',
+ Q_WS_QWS => 'undef',
+ Q_WS_MAC => 'undef',
+ Q_OBJECT => <<'CODE',
+public:
+ virtual QMetaObject *metaObject() const;
+ virtual const char *className() const;
+ virtual bool qt_invoke( int, QUObject* );
+ virtual bool qt_emit( int, QUObject* );
+ static QString tr( const char *, const char * = 0 );
+ static QString trUtf8( const char *, const char * = 0 );
+private:
+CODE
+};
+
+=head1 KDOC -- Source documentation tool
+
+ Sirtaj Singh Kang <taj@kde.org>, Dec 1998.
+
+=cut
+
+# read options
+
+Getopt::Long::config qw( no_ignore_case permute bundling auto_abbrev );
+
+GetOptions( \%options,
+ "format|f=s", \@formats_wanted,
+ "url|u=s",
+ "skip-internal", \$skipInternal,
+ "skip-deprecated|e",
+ "document-all|a",
+ "compress|z",
+ # HTML options
+ "html-cols=i",
+ "html-logo=s",
+
+ "strip-h-path", \$striphpath,
+ "outputdir|d=s", \$outputdir,
+ "stdin|i", \$readstdin,
+ "name|n=s", \$libname,
+ "version|v|V", \&show_version,
+ "private|p", \$doPrivate,
+ "globspace", \$parse_global_space,
+ "allow_k_dcop_accessors", \$allow_k_dcop_accessors,
+
+ "cpp|P", \$cpp,
+ "docincluded", \$docincluded,
+ "cppcmd|C=s", \$cppcmd,
+ "includedir|I=s", \@includes,
+ "define=s", \%defines, # define a single preprocessing symbol
+ "defines=s", \$defines, # file containing preprocessing symbols, one per line
+
+ "quiet|q", \$quiet,
+ "debug|D", \$debug, # debug the parsing
+ "debuggen", \$debuggen, # debug the file generation
+ "parse-only", \$parseonly )
+ || exit 1;
+
+$| = 1 if $debug or $debuggen;
+
+# preprocessor settings
+
+if ( $cppcmd eq "" ) {
+ $cppcmd = $defcppcmd;
+}
+else {
+ $cpp = 1;
+}
+
+if ( $#includes >= 0 && !$cpp ) {
+ die "$exe: --includedir requires --cpp\n";
+}
+
+# Check output formats. HTML is the default
+if( $#formats_wanted < 0 ) {
+ push @formats_wanted, "java";
+}
+
+foreach my $format ( @formats_wanted ) {
+ die "$exe: unsupported format '$format'.\n"
+ if !defined $formats{$format};
+}
+
+if( $defines )
+{
+ open( DEFS, $defines ) or die "Couldn't open $defines: $!\n";
+ my @defs = <DEFS>;
+ chomp @defs;
+ close DEFS;
+ foreach (@defs)
+ {
+ $defines{ $_ } = 1 unless exists $defines{ $_ };
+ }
+}
+
+# Check the %defines hash for QT_* symbols and compile the corresponding RE
+# Otherwise, compile the default ones. Used for filtering in readCxxLine.
+if ( my @qt_defines = map { ($_=~m/^QT_(.*)/)[0] } keys %defines)
+{
+ my $regexp = "m/^#\\s*ifn?def\\s+QT_(?:" . join('|', map { "\$qt_defines[$_]" } 0..$#qt_defines).")/o";
+ $match_qt_defines = eval "sub { my \$s=shift;
+ \$s=~/^#\\s*if(n)?def/ || return 0;
+ if(!\$1) { return \$s=~$regexp ? 0:1 }
+ else { return \$s=~$regexp ? 1:0 }
+ }";
+ die if $@;
+}
+else
+{
+ $match_qt_defines = eval q£
+ sub
+ {
+ my $s = shift;
+ $s =~ m/^\#\s*ifndef\s+QT_NO_(?:REMOTE| # not in the default compile options
+ NIS| # ...
+ XINERAMA|
+ IMAGEIO_(?:MNG|JPEG)|
+ STYLE_(?:MAC|INTERLACE|COMPACT)
+ )/x;
+ }
+ £;
+ die if $@;
+}
+# Check if there any files to process.
+# We do it here to prevent the libraries being loaded up first.
+
+checkFileArgs();
+
+######
+###### main program
+######
+ parseFiles();
+
+ if ( $parseonly ) {
+ print "\n\tParse Tree\n\t------------\n\n";
+ kdocAstUtil::dumpAst( $rootNode );
+ }
+ else {
+ writeDocumentation();
+ }
+
+ kdocAstUtil::printDebugStats() if $debug;
+
+ exit 0;
+######
+
+sub checkFileArgs
+{
+ return unless $#ARGV < 0;
+
+ die "$exe: no input files.\n" unless $readstdin;
+
+ # read filenames from standard input
+ while (<STDIN>) {
+ chop;
+ $_ =~ s,\\,/,g; # back to fwd slash (for Windows)
+ foreach my $file ( split( /\s+/, $_ ) ) {
+ push @ARGV, $file;
+ }
+ }
+}
+
+sub parseFiles
+{
+ foreach $currentfile ( @ARGV ) {
+ my $lang = "CXX";
+
+ if ( $currentfile =~ /\.idl\s*$/ ) {
+ # IDL file
+ $lang = "IDL";
+ }
+
+ # assume cxx file
+ if( $cpp ) {
+ # pass through preprocessor
+ my $cmd = $cppcmd;
+ foreach my $dir ( @includes ) {
+ $cmd .= " -I $dir ";
+ }
+
+ $cmd .= " -DQOBJECTDEFS_H $currentfile";
+
+ open( INPUT, "$cmd |" )
+ || croak "Can't preprocess $currentfile";
+ }
+ else {
+ open( INPUT, "$currentfile" )
+ || croak "Can't read from $currentfile";
+ }
+
+ print STDERR "$exe: processing $currentfile\n" unless $quiet;
+
+ # reset vars
+ $rootNode = getRoot( $lang );
+
+
+ # add to file lookup table
+ my $showname = $striphpath ? basename( $currentfile )
+ : $currentfile;
+ $cSourceNode = Ast::New( $showname );
+ $cSourceNode->AddProp( "NodeType", "source" );
+ $cSourceNode->AddProp( "Path", $currentfile );
+ $rootNode->AddPropList( "Sources", $cSourceNode );
+
+ # reset state
+ @classStack = ();
+ $cNode = $rootNode;
+ $inExtern = 0;
+ $inNamespace = 0;
+
+ # parse
+ my $k = undef;
+ while ( defined ($k = readDecl()) ) {
+ print "\nDecl: <$k>[$declNodeType]\n" if $debug;
+ if( identifyDecl( $k ) && $k =~ /{/ ) {
+ readCxxCodeBlock();
+ }
+ }
+ close INPUT;
+ }
+}
+
+
+sub writeDocumentation
+{
+ foreach my $node ( values %rootNodes ) {
+ # postprocess
+ kdocAstUtil::makeInherit( $node, $node );
+
+ # write
+ no strict "refs";
+ foreach my $format ( @formats_wanted ) {
+ my $pack = $formats{ $format };
+ require $pack.".pm";
+
+ print STDERR "Generating bindings for $format ",
+ "language...\n" if $debug;
+
+ my $f = "$pack\::writeDoc";
+ &$f( $libname, $node, $outputdir, \%options );
+ }
+ }
+}
+
+###### Parser routines
+
+=head2 readSourceLine
+
+ Returns a raw line read from the current input file.
+ This is used by routines outside main, since I don t know
+ how to share fds.
+
+=cut
+
+sub readSourceLine
+{
+ return <INPUT>;
+}
+
+=head2 readCxxLine
+
+ Reads a C++ source line, skipping comments, blank lines,
+ preprocessor tokens and the Q_OBJECT macro
+
+=cut
+
+sub readCxxLine
+{
+ my( $p );
+ my( $l );
+
+ while( 1 ) {
+ $p = shift @inputqueue || <INPUT>;
+ return undef if !defined ($p);
+
+ $p =~ s#//.*$##g; # C++ comment
+ $p =~ s#/\*(?!\*).*?\*/##g; # C comment
+
+ # join all multiline comments
+ if( $p =~ m#/\*(?!\*)#s ) {
+ # unterminated comment
+LOOP:
+ while( defined ($l = <INPUT>) ) {
+ $l =~ s#//.*$##g; # C++ comment
+ $p .= $l;
+ $p =~ s#/\*(?!\*).*?\*/##sg; # C comment
+ last LOOP unless $p =~ m#(/\*(?!\*))|(\*/)#sg;
+ }
+ }
+
+ if ( $p =~ /^\s*Q_OBJECT/ ) {
+ push @inputqueue, @codeqobject;
+ next;
+ }
+ # Hack, waiting for real handling of preprocessor defines
+ $p =~ s/QT_STATIC_CONST/static const/;
+ $p =~ s/KSVG_GET/KJS::Value get();/;
+ $p =~ s/KSVG_BASECLASS_GET/KJS::Value get();/;
+ $p =~ s/KSVG_BRIDGE/KJS::ObjectImp *bridge();/;
+ $p =~ s/KSVG_FORWARDGET/KJS::Value getforward();/;
+ $p =~ s/KSVG_PUT/bool put();/;
+ $p =~ s/KSVG_FORWARDPUT/bool putforward();/;
+ $p =~ s/KSVG_BASECLASS/virtual KJS::Value cache();/;
+ if ( $p =~ m/KSVG_DEFINE_PROTOTYPE\((\w+)\)/ ) {
+ push @inputqueue, split('\n',"namespace KSVG {\nclass $1 {\n};\n};");
+ }
+
+ next if ( $p =~ /^\s*$/s ); # blank lines
+# || $p =~ /^\s*Q_OBJECT/ # QObject macro
+# );
+#
+
+ next if ( $p =~ /^\s*Q_ENUMS/ # ignore Q_ENUMS
+ || $p =~ /^\s*Q_PROPERTY/ # and Q_PROPERTY
+ || $p =~ /^\s*Q_OVERRIDE/ # and Q_OVERRIDE
+ || $p =~ /^\s*Q_SETS/
+ || $p =~ /^\s*Q_DUMMY_COMPARISON_OPERATOR/
+ || $p =~ /^\s*K_SYCOCATYPE/ # and K_SYCOCA stuff
+ || $p =~ /^\s*K_SYCOCAFACTORY/ #
+ || $p =~ /^\s*KSVG_/ # and KSVG stuff ;)
+ || $p =~ /^\s*KDOM_/
+ );
+
+ push @includes_list, $1 if $p =~ /^#include\s+<?(.*?)>?\s*$/;
+
+ # remove all preprocessor macros
+ if( $p =~ /^\s*#\s*(\w+)/ ) {
+ # Handling of preprocessed sources: skip anything included from
+ # other files, unless --docincluded was passed.
+ if (!$docincluded && $p =~ /^\s*#\s*[0-9]+\s*\".*$/
+ && not($p =~ /\"$currentfile\"/)) {
+ # include file markers
+ while( <INPUT> ) {
+ last if(/\"$currentfile\"/);
+ print "Overread $_" if $debug;
+ };
+ print "Cont: $_" if $debug;
+ }
+ else {
+ # Skip platform-specific stuff, or #if 0 stuff
+ # or #else of something we parsed (e.g. for QKeySequence)
+ if ( $p =~ m/^#\s*ifdef\s*Q_WS_/ or
+ $p =~ m/^#\s*if\s+defined\(Q_WS_/ or
+ $p =~ m/^#\s*if\s+defined\(Q_OS_/ or
+ $p =~ m/^#\s*if\s+defined\(Q_CC_/ or
+ $p =~ m/^#\s*if\s+defined\(QT_THREAD_SUPPORT/ or
+ $p =~ m/^#\s*else/ or
+ $p =~ m/^#\s*if\s+defined\(Q_FULL_TEMPLATE_INSTANTIATION/ or
+ $p =~ m/^#\s*ifdef\s+CONTAINER_CUSTOM_WIDGETS/ or
+ &$match_qt_defines( $p ) or
+ $p =~ m/^#\s*if\s+0\s+/ ) {
+ my $if_depth = 1;
+ while ( defined $p && $if_depth > 0 ) {
+ $p = <INPUT>;
+ last if !defined $p;
+ $if_depth++ if $p =~ m/^#\s*if/;
+ $if_depth-- if $p =~ m/^#\s*endif/;
+ # Exit at #else in the #ifdef QT_NO_ACCEL/#else/#endif case
+ last if $if_depth == 1 && $p =~ m/^#\s*else\s/;
+ #ignore elif for now
+ print "Skipping ifdef'ed line: $p" if $debug;
+ }
+ }
+
+ # multiline macros
+ while ( defined $p && $p =~ m#\\\s*$# ) {
+ $p = <INPUT>;
+ }
+ }
+ next;
+ }
+
+ $lastLine = $p;
+ return $p;
+ }
+}
+
+=head2 readCxxCodeBlock
+
+ Reads a C++ code block (recursive curlies), returning the last line
+ or undef on error.
+
+ Parameters: none
+
+=cut
+
+sub readCxxCodeBlock
+{
+# Code: begins in a {, ends in }\s*;?
+# In between: cxx source, including {}
+ my ( $count ) = 0;
+ my $l = undef;
+
+ if ( defined $lastLine ) {
+ print "lastLine: '$lastLine'" if $debug;
+
+ my $open = kdocUtil::countReg( $lastLine, "{" );
+ my $close = kdocUtil::countReg( $lastLine, "}" );
+ $count = $open - $close;
+
+ return $lastLine if ( $open || $close) && $count == 0;
+ }
+
+ # find opening brace
+ if ( $count == 0 ) {
+ while( $count == 0 ) {
+ $l = readCxxLine();
+ return undef if !defined $l;
+ $l =~ s/\\.//g;
+ $l =~ s/'.?'//g;
+ $l =~ s/".*?"//g;
+
+ $count += kdocUtil::countReg( $l, "{" );
+ print "c ", $count, " at '$l'" if $debug;
+ }
+ $count -= kdocUtil::countReg( $l, "}" );
+ }
+
+ # find associated closing brace
+ while ( $count > 0 ) {
+ $l = readCxxLine();
+ croak "Confused by unmatched braces" if !defined $l;
+ $l =~ s/\\.//g;
+ $l =~ s/'.?'//g;
+ $l =~ s/".*?"//g;
+
+ my $add = kdocUtil::countReg( $l, "{" );
+ my $sub = kdocUtil::countReg( $l, "}" );
+ $count += $add - $sub;
+
+ print "o ", $add, " c ", $sub, " at '$l'" if $debug;
+ }
+
+ undef $lastLine;
+ return $l;
+}
+
+=head2 readDecl
+
+ Returns a declaration and sets the $declNodeType variable.
+
+ A decl starts with a type or keyword and ends with [{};]
+ The entire decl is returned in a single line, sans newlines.
+
+ declNodeType values: undef for error, "a" for access specifier,
+ "c" for doc comment, "d" for other decls.
+
+ readCxxLine is used to read the declaration.
+
+=cut
+
+sub readDecl
+{
+ undef $declNodeType;
+ my $l = readCxxLine();
+ my ( $decl ) = "";
+
+ my $allowed_accesors = "private|public|protected|signals";
+ $allowed_accesors .= "|$allowed_k_dcop_accesors_re" if $allow_k_dcop_accessors;
+
+ if( !defined $l ) {
+ return undef;
+ }
+ elsif ( $l =~ /^\s*($allowed_accesors)
+ (\s+\w+)?\s*:/x) { # access specifier
+ $declNodeType = "a";
+ return $l;
+ }
+ elsif ( $l =~ /K_DCOP/ ) {
+ $declNodeType = "k";
+ return $l;
+ }
+ elsif ( $l =~ m#^\s*/\*\*# ) { # doc comment
+ $declNodeType = "c";
+ return $l;
+ }
+
+ do {
+ $decl .= $l;
+
+ if ( $l =~ /[{};]/ ) {
+ $decl =~ s/\n/ /gs;
+ $declNodeType = "d";
+ return $decl;
+ }
+ return undef if !defined ($l = readCxxLine());
+
+ } while ( 1 );
+}
+
+#### AST Generator Routines
+
+=head2 getRoot
+
+ Return a root node for the given type of input file.
+
+=cut
+
+sub getRoot
+{
+ my $type = shift;
+ carp "getRoot called without type" unless defined $type;
+
+ if ( !exists $rootNodes{ $type } ) {
+ my $node = Ast::New( "Global" ); # parent of all nodes
+ $node->AddProp( "NodeType", "root" );
+ $node->AddProp( "RootType", $type );
+ $node->AddProp( "Compound", 1 );
+ $node->AddProp( "KidAccess", "public" );
+
+ $rootNodes{ $type } = $node;
+ }
+ print "getRoot: call for $type\n" if $debug;
+
+ return $rootNodes{ $type };
+}
+
+=head2 identifyDecl
+
+ Parameters: decl
+
+ Identifies a declaration returned by readDecl. If a code block
+ needs to be skipped, this subroutine returns a 1, or 0 otherwise.
+
+=cut
+
+sub identifyDecl
+{
+ my( $decl ) = @_;
+
+ my $newNode = undef;
+ my $skipBlock = 0;
+
+ # Doc comment
+ if ( $declNodeType eq "c" ) {
+ $docNode = kdocParseDoc::newDocComment( $decl );
+
+ # if it's the main doc, it is attached to the root node
+ if ( defined $docNode->{LibDoc} ) {
+ kdocParseDoc::attachDoc( $rootNode, $docNode,
+ $rootNode );
+ undef $docNode;
+ }
+
+ }
+ elsif ( $declNodeType eq "a" ) {
+ newAccess( $decl );
+ }
+ elsif ( $declNodeType eq "k" ) {
+ $cNode->AddProp( "DcopExported", 1 );
+ }
+
+ # Typedef struct/class
+ elsif ( $decl =~ /^\s*typedef
+ \s+(struct|union|class|enum)
+ \s*([_\w\:]*)
+ \s*([;{])
+ /xs ) {
+ my ($type, $name, $endtag, $rest ) = ($1, $2, $3, $' );
+ $name = "--" if $name eq "";
+
+ warn "typedef '$type' n:'$name'\n" if $debug;
+
+ if ( $rest =~ /}\s*([\w_]+(?:::[\w_])*)\s*;/ ) {
+ # TODO: Doesn't parse members yet!
+ $endtag = ";";
+ $name = $1;
+ }
+
+ $newNode = newTypedefComp( $type, $name, $endtag );
+ }
+
+ # Typedef
+ elsif ( $decl =~ /^\s*typedef\s+
+ (?:typename\s+)? # `typename' keyword
+ (.*?\s*[\*&]?) # type
+ \s+([-\w_\:]+) # name
+ \s*((?:\[[-\w_\:<>\s]*\])*) # array
+ \s*[{;]\s*$/xs ) {
+
+ print "Typedef: <$1 $3> <$2>\n" if $debug;
+ $newNode = newTypedef( $1." ".$3, $2 );
+ }
+
+ # Enum
+ elsif ( $decl =~ /^\s*enum\s+([-\w_:]*)?\s*\{(.*)/s ) {
+
+ print "Enum: <$1>\n" if $debug;
+ my $enumname = defined $2 ? $1 : "";
+
+ $newNode = newEnum( $enumname );
+ }
+
+ # Class/Struct
+ elsif ( $decl =~ /^\s*((?:template\s*<.*>)?) # 1 template
+ \s*(class|struct|union|namespace) # 2 struct type
+ \s*([A-Z_]*EXPORT[A-Z_]*)? # 3 export
+ (?:\s*Q_PACKED)?
+ (?:\s*Q_REFCOUNT)?
+ \s+([\w_]+ # 4 name
+ (?:<[\w_ :,]+?>)? # maybe explicit template
+ # (eat chars between <> non-hungry)
+ (?:::[\w_]+)* # maybe nested
+ )
+ ([^\(]*?) # 5 inheritance
+ ([;{])/xs ) { # 6 rest
+
+ print "Class: => [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n\t[$6]\n" if $debug;
+ my ( $tmpl, $ntype, $export, $name, $rest, $endtag ) =
+ ( $1, $2, $3, $4, $5, $6 );
+
+ if ($ntype eq 'namespace') {
+ if ($decl =~ /}/) {
+ return 0;
+ }
+ # Set a flag to indicate we're in a multi-line namespace declaration
+ $inNamespace = 1;
+ }
+
+
+ my @inherits = ();
+
+ $tmpl =~ s/<(.*)>/$1/ if $tmpl ne "";
+
+ if( $rest =~ /^\s*:\s*/ ) {
+ # inheritance
+ $rest = $';
+ @inherits = parseInheritance( $rest );
+ }
+
+ $newNode = newClass( $tmpl, $ntype, $export,
+ $name, $endtag, @inherits );
+ }
+ # IDL compound node
+ elsif( $decl =~ /^\s*(module|interface|exception) # struct type
+ \s+([-\w_]+) # name
+ (.*?) # inheritance?
+ ([;{])/xs ) {
+
+ my ( $type, $name, $rest, $fwd, $complete )
+ = ( $1, $2, $3, $4 eq ";" ? 1 : 0,
+ 0 );
+ my @in = ();
+ print "IDL: [$type] [$name] [$rest] [$fwd]\n" if $debug;
+
+ if( $rest =~ /^\s*:\s*/ ) {
+ $rest = $';
+ $rest =~ s/\s+//g;
+ @in = split ",", $rest;
+ }
+ if( $decl =~ /}\s*;/ ) {
+ $complete = 1;
+ }
+
+ $newNode = newIDLstruct( $type, $name, $fwd, $complete, @in );
+ }
+ # Method
+ elsif ( $decl =~ /^\s*(?:(?:class|struct)\s*)?([^=]+?(?:operator\s*(?:\(\)|.?=)\s*)?) # ret+nm
+ \( (.*?) \) # parameters
+ \s*((?:const)?)\s*
+ (?:throw\s*\(.*?\))?
+ \s*((?:=\s*0(?:L?))?)\s* # Pureness. is "0L" allowed?
+ \s*[;{]+/xs ) { # rest
+
+ my $tpn = $1; # type + name
+ my $params = $2;
+ # Remove constructor initializer, that's not in the params
+ if ( $params =~ /\s*\)\s*:\s*/ ) {
+ # Hack: first .* made non-greedy for QSizePolicy using a?(b):c in ctor init
+ $params =~ s/(.*?)\s*\)\s*:\s*.*$/$1/;
+ }
+
+ my $const = $3 eq "" ? 0 : 1;
+ my $pure = $4 eq "" ? 0 : 1;
+ $tpn =~ s/\s+/ /g;
+ $params =~ s/\s+/ /g;
+
+ print "Method: R+N:[$tpn]\n\tP:[$params]\n\t[$const]\n" if $debug;
+
+ if ( $tpn =~ /((?:\w+\s*::\s*)?operator.*?)\s*$/ # operator
+ || $tpn =~ /((?:\w*\s*::\s*~?)?[-\w:]+)\s*$/ ) { # normal
+ my $name = $1;
+ $tpn = $`;
+ $newNode = newMethod( $tpn, $name,
+ $params, $const, $pure );
+ }
+
+ $skipBlock = 1; # FIXME check end token before doing this!
+ }
+ # Using: import namespace
+ elsif ( $decl =~ /^\s*using\s+namespace\s+(\w+)/ ) {
+ newNamespace( $1 );
+
+ }
+
+ # extern block
+ elsif ( $decl =~ /^\s*extern\s*"(.*)"\s*{/ ) {
+ $inExtern = 1 unless $decl =~ /}/;
+ }
+
+ # Single variable
+ elsif ( $decl =~ /^
+ \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? )# type
+ \s*(?:<.+>)? # template
+ \s*(?:[\&\*])? # ptr or ref
+ (?:\s*(?:const|volatile))* )
+ \s*([\w_:]+) # name
+ \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array
+ \s*((?:=.*)?) # value
+ \s*([;{])\s*$/xs ) {
+ my $type = $1;
+ my $name = $2;
+ my $arr = $3;
+ my $val = $4;
+ my $end = $5;
+
+ $type =~ s/\s+/ /g;
+
+ if ( $type !~ /^friend\s+class\s*/ ) {
+ print "Var: [$name] type: [$type$arr] val: [$val]\n"
+ if $debug;
+
+ $newNode = newVar( $type.$arr, $name, $val );
+ }
+
+ $skipBlock = 1 if $end eq '{';
+ }
+
+ # Multi variables
+ elsif ( $decl =~ m/^
+ \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? ) # type
+ \s*(?:<.+>)?) # template
+
+ \s*( (?:\s*(?: [\&\*][\&\*\s]*)? # ptr or ref
+ [\w_:]+) # name
+ \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array
+ \s*(?:, # extra vars
+ \s*(?: [\&\*][\&\*\s]*)? # ptr or ref
+ \s*(?:[\w_:]+) # name
+ \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array
+ )*
+ \s*(?:=.*)?) # value
+ \s*[;]/xs ) {
+
+ my $type = $1;
+ my $names = $2;
+ my $end = $3;
+ my $doc = $docNode;
+
+ print "Multivar: type: [$type] names: [$names] \n" if $debug;
+
+ foreach my $vardecl ( split( /\s*,\s*/, $names ) ) {
+ next unless $vardecl =~ m/
+ \s*((?: [\&\*][\&\*\s]*)?) # ptr or ref
+ \s*([\w_:]+) # name
+ \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array
+ \s*((?:=.*)?) # value
+ /xs;
+ my ($ptr, $name, $arr, $val) = ($1, $2, $3, $4);
+
+ print "Split: type: [$type$ptr$arr] ",
+ " name: [$name] val: [$val] \n" if $debug;
+
+ my $node = newVar( $type.$ptr.$arr, $name, $val );
+
+ $docNode = $doc; # reuse docNode for each
+ postInitNode( $node ) unless !defined $node;
+ }
+
+ $skipBlock = 1 if $end eq '{';
+ }
+ # end of an "extern" block
+ elsif ( $decl =~ /^\s*}\s*$/ && $inExtern ) {
+ $inExtern = 0;
+ }
+ # end of an in-block declaration
+ elsif ( $decl =~ /^\s*}\s*(.*?)\s*;\s*$/ || ($decl =~ /^\s*}\s*$/ && $inNamespace) ) {
+
+ if ( $cNode->{astNodeName} eq "--" ) {
+ # structure typedefs should have no name preassigned.
+ # If they do, then the name in
+ # "typedef struct <name> { ..." is kept instead.
+ # TODO: Buglet. You should fix YOUR code dammit. ;)
+
+
+ $cNode->{astNodeName} = $1;
+ my $siblings = $cNode->{Parent}->{KidHash};
+ undef $siblings->{"--"};
+ $siblings->{ $1 } = $cNode;
+ }
+
+ # C++ namespaces end with a '}', and not '};' like classes
+ if ($decl =~ /^\s*}\s*$/ ) {
+ $inNamespace = 0;
+ }
+
+ if ( $#classStack < 0 ) {
+ confess "close decl found, but no class in stack!" ;
+ $cNode = $rootNode;
+ }
+ else {
+ $cNode = pop @classStack;
+ print "end decl: popped $cNode->{astNodeName}\n"
+ if $debug;
+ }
+ }
+ # unidentified block start
+ elsif ( $decl =~ /{/ ) {
+ print "Unidentified block start: $decl\n" if $debug;
+ $skipBlock = 1;
+ }
+ # explicit template instantiation, or friend template
+ elsif ( $decl =~ /(template|friend)\s+class\s+(?:Q[A-Z_]*EXPORT[A-Z_]*\s*)?\w+\s*<.*>\s*;/x ) {
+ # Nothing to be done with those.
+ }
+ else {
+
+ ## decl is unidentified.
+ warn "Unidentified decl: $decl\n";
+ }
+
+ # once we get here, the last doc node is already used.
+ # postInitNode should NOT be called for forward decls
+ postInitNode( $newNode ) unless !defined $newNode;
+
+ return $skipBlock;
+}
+
+sub postInitNode
+{
+ my $newNode = shift;
+
+ carp "Cannot postinit undef node." if !defined $newNode;
+
+ # The reasoning here:
+ # Forward decls never get a source node.
+ # Once a source node is defined, don't assign another one.
+
+ if ( $newNode->{NodeType} ne "Forward" && !defined $newNode->{Source}) {
+ $newNode->AddProp( "Source", $cSourceNode );
+ } elsif ( $newNode->{NodeType} eq "Forward" ) {
+ if ($debug) {
+ print "postInit: skipping fwd: $newNode->{astNodeName}\n";
+ }
+ undef $docNode;
+ return;
+ }
+
+ if( defined $docNode ) {
+ kdocParseDoc::attachDoc( $newNode, $docNode, $rootNode );
+ undef $docNode;
+ }
+}
+
+
+##### Node generators
+
+=head2 newEnum
+
+ Reads the parameters of an enumeration.
+
+ Returns the parameters, or undef on error.
+
+=cut
+
+sub newEnum
+{
+ my ( $enum ) = @_;
+ my $k = undef;
+ my $params = "";
+
+ $k = $lastLine if defined $lastLine;
+
+ if( defined $lastLine && $lastLine =~ /{/ ) {
+ $params = $';
+ if ( $lastLine =~ /}(.*?);/ ) {
+ return initEnum( $enum, $1, $params );
+ }
+ }
+
+ while ( defined ( $k = readCxxLine() ) ) {
+ $params .= $k;
+
+ if ( $k =~ /}(.*?);/ ) {
+ return initEnum( $enum, $1, $params );
+ }
+ }
+
+ return undef;
+}
+
+=head2 initEnum
+
+ Parameters: name, (ref) params
+
+ Returns an initialized enum node.
+
+=cut
+
+sub initEnum
+{
+ my( $name, $end, $params ) = @_;
+
+ ($name = $end) if $name eq "" && $end ne "";
+
+ $params =~ s#\s+# #sg; # no newlines
+ $params =~ s#\s*/\*([^\*]/|\*[^/]|[^\*/])*\*/##g; # strip out comments
+ $params = $1 if $params =~ /^\s*{?(.*)}/;
+ print "$name params: [$params]\n" if $debug;
+
+
+ my ( $node ) = Ast::New( $name );
+ $node->AddProp( "NodeType", "enum" );
+ $node->AddProp( "Params", $params );
+ makeParamList( $node, $params, 1 ); # Adds the ParamList property containing the list of param nodes
+ kdocAstUtil::attachChild( $cNode, $node );
+
+ return $node;
+}
+
+=head2 newIDLstruct
+
+ Parameters: type, name, forward, complete, inherits...
+
+ Handles an IDL structure definition (ie module, interface,
+ exception).
+
+=cut
+
+sub newIDLstruct
+{
+ my ( $type, $name, $fwd, $complete ) = @_;
+
+ my $node = exists $cNode->{KidHash} ?
+ $cNode->{KidHash}->{ $name } : undef;
+
+ if( !defined $node ) {
+ $node = Ast::New( $name );
+ $node->AddProp( "NodeType", $fwd ? "Forward" : $type );
+ $node->AddProp( "KidAccess", "public" );
+ $node->AddProp( "Compound", 1 ) unless $fwd;
+ kdocAstUtil::attachChild( $cNode, $node );
+ }
+ elsif ( $fwd ) {
+ # If we have a node already, we ignore forwards.
+ return undef;
+ }
+ elsif ( $node->{NodeType} eq "Forward" ) {
+ # we are defining a previously forward node.
+ $node->AddProp( "NodeType", $type );
+ $node->AddProp( "Compound", 1 );
+ $node->AddProp( "Source", $cSourceNode );
+ }
+
+ # register ancestors.
+ foreach my $ances ( splice ( @_, 4 ) ) {
+ my $n = kdocAstUtil::newInherit( $node, $ances );
+ }
+
+ if( !( $fwd || $complete) ) {
+ print "newIDL: pushing $cNode->{astNodeName},",
+ " new is $node->{astNodeName}\n"
+ if $debug;
+ push @classStack, $cNode;
+ $cNode = $node;
+ }
+
+ return $node;
+}
+
+=head2 newClass
+
+ Parameters: tmplArgs, cNodeType, export, name, endTag, @inheritlist
+
+ Handles a class declaration (also fwd decls).
+
+=cut
+
+sub newClass
+{
+ my( $tmplArgs, $cNodeType, $export, $name, $endTag ) = @_;
+
+ my $access = "private";
+ $access = "public" if $cNodeType ne "class";
+
+ # try to find an exisiting node, or create a new one
+ # We need to make the fully-qualified-name otherwise findRef will look
+ # for that classname in the global namespace
+ # testcase: class Foo; namespace Bar { class Foo { ... } }
+ my @parents;
+ push @parents, kdocAstUtil::heritage($cNode) if (defined $cNode->{Parent});
+ push @parents, $name;
+ my $fullyQualifiedName = join "::", @parents;
+ print "looking for $fullyQualifiedName\n" if($debug);
+ my $oldnode = kdocAstUtil::findRef( $cNode, $fullyQualifiedName );
+ my $node = defined $oldnode ? $oldnode : Ast::New( $name );
+
+ if ( $endTag ne "{" ) {
+ # forward
+ if ( !defined $oldnode ) {
+ # new forward node
+ $node->AddProp( "NodeType", "Forward" );
+ $node->AddProp( "KidAccess", $access );
+ print "newClass: Attaching $node->{astNodeName} to $cNode->{astNodeName}\n" if $debug;
+ kdocAstUtil::attachChild( $cNode, $node );
+ }
+ return $node;
+ }
+
+ # this is a class declaration
+
+ print "ClassName: $name\n" if $debug;
+
+ $node->AddProp( "NodeType", $cNodeType );
+ $node->AddProp( "Compound", 1 );
+ $node->AddProp( "Source", $cSourceNode );
+
+ if ($cNodeType eq 'namespace') {
+ $node->AddPropList( "Sources", $cSourceNode );
+ }
+
+ $node->AddProp( "KidAccess", $access );
+ $node->AddProp( "Export", $export ) unless $export eq "";
+ $node->AddProp( "Tmpl", $tmplArgs ) unless $tmplArgs eq "";
+
+ if ( !defined $oldnode ) {
+ print "newClass: Attaching $node->{astNodeName} to $cNode->{astNodeName}\n" if $debug;
+ kdocAstUtil::attachChild( $cNode, $node );
+ } else {
+ print "newClass: Already found $node->{astNodeName} in $cNode->{astNodeName}\n" if $debug;
+ }
+
+ # inheritance
+
+ foreach my $ances ( splice (@_, 5) ) {
+ my $type = "";
+ my $name = $ances;
+ my $intmpl = undef;
+
+WORD:
+ foreach my $word ( split ( /([\w:]+(:?\s*<.*>)?)/, $ances ) ) {
+ next WORD unless $word =~ /^[\w:]/;
+ if ( $word =~ /(private|public|protected|virtual)/ ) {
+ $type .= "$1 ";
+ }
+ else {
+
+ if ( $word =~ /<(.*)>/ ) {
+ # FIXME: Handle multiple tmpl args
+ $name = $`;
+ $intmpl = $1;
+ }
+ else {
+ $name = $word;
+ }
+
+ last WORD;
+ }
+ }
+
+ # set inheritance access specifier if none specified
+ if ( $type eq "" ) {
+ $type = $cNodeType eq "class" ? "private ":"public ";
+ }
+ chop $type;
+
+ # attach inheritance information
+ my $n = kdocAstUtil::newInherit( $node, $name );
+ $n->AddProp( "Type", $type );
+
+ $n->AddProp( "TmplType", $intmpl ) if defined $intmpl;
+
+ print "In: $name type: $type, tmpl: $intmpl\n" if $debug;
+ }
+
+ # new current node
+ print "newClass: Pushing $cNode->{astNodeName}, new current node is $node->{astNodeName}\n" if $debug;
+ push ( @classStack, $cNode );
+ $cNode = $node;
+
+ return $node;
+}
+
+
+=head3 parseInheritance
+
+ Param: inheritance decl string
+ Returns: list of superclasses (template decls included)
+
+ This will fail if < and > appear in strings in the decl.
+
+=cut
+
+sub parseInheritance
+{
+ my $instring = shift;
+ my @inherits = ();
+
+ my $accum = "";
+ foreach $instring ( split (/\s*,\s*/, $instring) ) {
+ $accum .= $instring.", ";
+ next unless (kdocUtil::countReg( $accum, "<" )
+ - kdocUtil::countReg( $accum, ">" ) ) == 0;
+
+ # matching no. of < and >, so assume the parent is
+ # complete
+ $accum =~ s/,\s*$//;
+ print "Inherits: '$accum'\n" if $debug;
+ push @inherits, $accum;
+ $accum = "";
+ }
+
+ return @inherits;
+}
+
+
+=head2 newNamespace
+
+ Param: namespace name.
+ Returns nothing.
+
+ Imports a namespace into the current node, for ref searches etc.
+ Triggered by "using namespace ..."
+
+=cut
+
+sub newNamespace
+{
+ $cNode->AddPropList( "ImpNames", shift );
+}
+
+
+
+=head2 newTypedef
+
+ Parameters: realtype, name
+
+ Handles a type definition.
+
+=cut
+
+sub newTypedef
+{
+ my ( $realtype, $name ) = @_;
+
+ my ( $node ) = Ast::New( $name );
+
+ $node->AddProp( "NodeType", "typedef" );
+ $node->AddProp( "Type", $realtype );
+
+ kdocAstUtil::attachChild( $cNode, $node );
+
+ return $node;
+}
+
+=head2 newTypedefComp
+
+ Params: realtype, name endtoken
+
+ Creates a new compound type definition.
+
+=cut
+
+sub newTypedefComp
+{
+ my ( $realtype, $name, $endtag ) = @_;
+
+ my ( $node ) = Ast::New( $name );
+
+ $node->AddProp( "NodeType", "typedef" );
+ $node->AddProp( "Type", $realtype );
+
+ kdocAstUtil::attachChild( $cNode, $node );
+
+ if ( $endtag eq '{' ) {
+ print "newTypedefComp: Pushing $cNode->{astNodeName}\n"
+ if $debug;
+ push ( @classStack, $cNode );
+ $cNode = $node;
+ }
+
+ return $node;
+}
+
+
+=head2 newMethod
+
+ Parameters: retType, name, params, const, pure?
+
+ Handles a new method declaration or definition.
+
+=cut
+BEGIN {
+
+my $theSourceNode = $cSourceNode;
+
+sub newMethod
+{
+ my ( $retType, $name, $params, $const, $pure ) = @_;
+ my $parent = $cNode;
+ my $class;
+
+ print "Cracked: [$retType] [$name]\n\t[$params]\n\t[$const]\n"
+ if $debug;
+
+ if ( $retType =~ /([\w\s_<>,]+)\s*::\s*$/ ) {
+ # check if stuff before :: got into rettype by mistake.
+ $retType = $`;
+ ($name = $1."::".$name);
+ $name =~ s/\s+/ /g;
+ print "New name = \"$name\" and type = '$retType'\n" if $debug;
+ }
+
+ # A 'friend method' declaration isn't a real method declaration
+ return undef if ( $retType =~ /^friend\s+/ || $retType =~ /^friend\s+class\s+/ );
+
+ my $isGlobalSpace = 0;
+
+ if( $name =~ /^\s*(.*?)\s*::\s*(.*?)\s*$/ ) {
+ # Fully qualified method name.
+ $name = $2;
+ $class = $1;
+
+ if( $class =~ /^\s*$/ ) {
+ $parent = $rootNode;
+ }
+ elsif ( $class eq $cNode->{astNodeName} ) {
+ $parent = $cNode;
+ }
+ else {
+ # ALWAYS IGNORE...
+ return undef;
+
+ my $node = kdocAstUtil::findRef( $cNode, $class );
+
+ if ( !defined $node ) {
+ # if we couldn't find the name, try again with
+ # all template parameters stripped off:
+ my $strippedClass = $class;
+ $strippedClass =~ s/<[^<>]*>//g;
+
+ $node = kdocAstUtil::findRef( $cNode, $strippedClass );
+
+ # if still not found: give up
+ if ( !defined $node ) {
+ warn "$exe: Unidentified class: $class ".
+ "in $currentfile\:$.\n";
+ return undef;
+ }
+ }
+
+ $parent = $node;
+ }
+ }
+ # TODO fix for $retType =~ /template<.*?>/
+ elsif( $parse_global_space && $parent->{NodeType} eq "root" && $name !~ /\s*qt_/ && $retType !~ /template\s*<.*?>/ ) {
+ $class = $globalSpaceClassName; # FIXME - sanitize the naming system?
+ $isGlobalSpace = 1;
+
+ my $opsNode = kdocAstUtil::findRef( $cNode, $class );
+ if (!$opsNode) {
+ # manually create a "GlobalSpace" class
+ $opsNode = Ast::New( $class );
+ $opsNode->AddProp( "NodeType", "class" );
+ $opsNode->AddProp( "Compound", 1 );
+ $opsNode->AddProp( "Source", $cSourceNode ); # dummy
+ $opsNode->AddProp( "KidAccess", "public" );
+ kdocAstUtil::attachChild( $cNode, $opsNode );
+ }
+ # Add a special 'Source' property for methods in global space
+ $cNode->AddProp( "Source", $theSourceNode );
+ unless( $theSourceNode == $cSourceNode ) {
+ $theSourceNode = $cSourceNode;
+ $opsNode->AddPropList( "Sources", $theSourceNode ); # sources are scattered across Qt
+ }
+ $parent = $opsNode;
+ }
+
+ # flags
+
+ my $flags = "";
+
+ if( $retType =~ /static/ || $isGlobalSpace ) {
+ $flags .= "s";
+ $retType =~ s/static//g;
+ }
+
+ if( $const && !$isGlobalSpace ) {
+ $flags .= "c";
+ }
+
+ if( $pure ) {
+ $flags .= "p";
+ }
+
+ if( $retType =~ /virtual/ ) {
+ $flags .= "v";
+ $retType =~ s/virtual//g;
+ }
+
+ print "\n" if $flags ne "" && $debug;
+
+ if ( !defined $parent->{KidAccess} ) {
+ warn "'", $parent->{astNodeName}, "' has no KidAccess ",
+ exists $parent->{Forward} ? "(forward)\n" :"\n";
+ }
+
+ # NB, these are =~, so make sure they are listed in correct order
+ if ( $parent->{KidAccess} =~ /slot/ ) {
+ $flags .= "l";
+ }
+ elsif ( $parent->{KidAccess} =~ /k_dcop_signals/ ) {
+ $flags .= "z";
+ }
+ elsif ( $parent->{KidAccess} =~ /k_dcop_hidden/ ) {
+ $flags .= "y";
+ }
+ elsif ( $parent->{KidAccess} =~ /k_dcop/ ) {
+ $flags .= "d";
+ }
+ elsif ( $parent->{KidAccess} =~ /signal/ ) {
+ $flags .= "n";
+ }
+
+ $retType =~ s/QM?_EXPORT[_A-Z]*\s*//;
+ $retType =~ s/inline\s+//;
+ $retType =~ s/extern\s+//;
+ $retType =~ s/^\s*//g;
+ $retType =~ s/\s*$//g;
+ $retType =~ s/^class\s/ /; # Remove redundant class forward decln's
+ $retType =~ s/<class\s/</;
+
+ # node
+
+ my $node = Ast::New( $name );
+ $node->AddProp( "NodeType", "method" );
+ $node->AddProp( "Flags", $flags );
+ $node->AddProp( "ReturnType", $retType );
+ $node->AddProp( "Params", $params ); # The raw string with the whole param list
+ makeParamList( $node, $params, 0 ); # Adds the ParamList property containing the list of param nodes
+
+ $parent->AddProp( "Pure", 1 ) if $pure;
+
+ kdocAstUtil::attachChild( $parent, $node );
+ return $node;
+}
+
+}
+
+=head2 makeParamList
+
+ Parameters:
+ * method (or enum) node
+ * string containing the whole param list
+ * 1 for enums
+
+ Adds a property "ParamList" to the method node.
+ This property contains a list of nodes, one for each parameter.
+
+ Each parameter node has the following properties:
+ * ArgType the type of the argument, e.g. const QString&
+ * ArgName the name of the argument - optionnal
+ * DefaultValue the default value of the argument - optionnal
+
+ For enum values, ArgType is unset, ArgName is the name, DefaultValue its value.
+
+ Author: David Faure <faure@kde.org>
+=cut
+
+sub makeParamList($$$)
+{
+ my ( $methodNode, $params, $isEnum ) = @_;
+ $params =~ s/\s+/ /g; # normalize multiple spaces/tabs into a single one
+ $params =~ s/\s*([\*\&])\s*/$1 /g; # normalize spaces before and after *, &
+ $params =~ s/\s*(,)([^'\s])\s*/$1 $2/g; # And after ',', but not if inside single quotes
+ $params =~ s/^\s*void\s*$//; # foo(void) ==> foo()
+ $params =~ s/^\s*$//;
+ # Make sure the property always exists, makes iteration over it easier
+ $methodNode->AddProp( "ParamList", [] );
+
+ my @args = kdocUtil::splitUnnested( ',', $params);
+
+ my $argId = 0;
+ foreach my $arg ( @args ) {
+ my $argType;
+ my $argName;
+ my $defaultparam;
+ $arg =~ s/\s*([^\s].*[^\s])\s*/$1/; # stripWhiteSpace
+ $arg =~ s/(\w+)\[\]/\* $1/; # Turn [] array into *
+ $arg =~ s/^class //; # Remove any redundant 'class' forward decln's
+
+ # The RE below reads as: = ( string constant or char or cast to numeric literal
+ # or some word/number, with optional bitwise shifts, OR'ed or +'ed flags, and/or function call ).
+ if ( $arg =~ s/\s*=\s*(("[^\"]*")|\([^)]*\)\s*[\+-]?\s*[0-9]+|(\'.\')|(([-\w:~]*)\s*([<>\|\+-]*\s*[\w._]*\s*)*(\([^(]*\))?))// ) {
+ $defaultparam = $1;
+ }
+
+ if (defined $defaultparam && $isEnum) {
+ # Remove any casts in enum values, for example this in kfileitem.h:
+ # 'enum { Unknown = (mode_t) - 1 };'
+ $defaultparam =~ s/\([^\)]+\)(.*[0-9].*)/$1/;
+ }
+
+ # Separate arg type from arg name, if the latter is specified
+ if ( $arg =~ /(.*)\s+([\w_]+)\s*$/ || $arg =~ /(.*)\(\s*\*\s([\w_]+)\)\s*\((.*)\)\s*$/ ) {
+ if ( defined $3 ) { # function pointer
+ $argType = $1."(*)($3)";
+ $argName = $2;
+ } else {
+ $argType = $1;
+ $argName = $2;
+ }
+ } else { # unnamed arg - or enum value
+ $argType = $arg if (!$isEnum);
+ $argName = $arg if ($isEnum);
+ }
+ $argId++;
+
+ my $node = Ast::New( $argId ); # let's make the arg index the node "name"
+ $node->AddProp( "NodeType", "param" );
+ $node->AddProp( "ArgType", $argType );
+ $node->AddProp( "ArgName", $argName ) if (defined $argName);
+ $node->AddProp( "DefaultValue", $defaultparam ) if (defined $defaultparam);
+ $methodNode->AddPropList( "ParamList", $node );
+ #print STDERR "ArgType: $argType ArgName: $argName\n" if ($debug);
+ }
+}
+
+=head2 newAccess
+
+ Parameters: access
+
+ Sets the default "Access" specifier for the current class node. If
+ the access is a "slot" type, "_slots" is appended to the access
+ string.
+
+=cut
+
+sub newAccess
+{
+ my ( $access ) = @_;
+
+ return undef unless ($access =~ /^\s*(\w+)\s*(slots|$allowed_k_dcop_accesors_re)?/);
+
+ print "Access: [$1] [$2]\n" if $debug;
+
+ $access = $1;
+
+ if ( defined $2 && $2 ne "" ) {
+ $access .= "_" . $2;
+ }
+
+ $cNode->AddProp( "KidAccess", $access );
+
+ return $cNode;
+}
+
+
+=head2 newVar
+
+ Parameters: type, name, value
+
+ New variable. Value is ignored if undef
+
+=cut
+
+sub newVar
+{
+ my ( $type, $name, $val ) = @_;
+
+ my $node = Ast::New( $name );
+ $node->AddProp( "NodeType", "var" );
+
+ my $static = 0;
+ if ( $type =~ /static/ ) {
+ # $type =~ s/static//;
+ $static = 1;
+ }
+
+ $node->AddProp( "Type", $type );
+ $node->AddProp( "Flags", 's' ) if $static;
+ $node->AddProp( "Value", $val ) if defined $val;
+ kdocAstUtil::attachChild( $cNode, $node );
+
+ return $node;
+}
+
+
+
+=head2 show_version
+
+ Display short version information and quit.
+
+=cut
+
+sub show_version
+{
+ die "$exe: $Version (c) Sirtaj S. Kang <taj\@kde.org>\n";
+}