fpc/utils/kalyptus/kalyptus

#!/usr/bin/perl

# KDOC -- C++ and CORBA IDL interface documentation tool.
# Sirtaj Singh Kang <[email protected]>, Jan 1999.
# $Id: kalyptus,v 1.1 2003/09/22 01:35:54 florian Exp $

# 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 %options @formats_wanted
        @includeclasses $includeclasses $skipInternal %defines $defines $match_qt_defines
	$libdir $libname $outputdir @libs $striphpath $doPrivate $readstdin
	$Version $quiet $debug $debuggen $parseonly $currentfile $cSourceNode $exe
	%formats %flagnames $rootNode @classStack $cNode
	$lastLine $docNode @includes $cpp $defcppcmd $cppcmd $docincluded
	$inExtern %stats %definitions @inputqueue @codeqobject /;
     
## globals

%rootNodes = ();			# root nodes for each file type
$declNodeType = undef;			# last declaration type

# All options

%options = ();				# hash of options (set getopt below)
@formats_wanted = ();
$libdir = $ENV{KDOCLIBS};
$libname = "";
$outputdir = ".";
@libs = ();				# list of includes
$striphpath = 0;

@includeclasses = ();                     # names of classes to include
$includeclasses = "";

$doPrivate = 0;
$Version = "0.9";

$quiet = 0;
$debug = 0;
$debuggen = 0;
$parseonly = 0;

$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 = ( "java" => "kalyptusCxxToJava", "c" => "kalyptusCxxToC",
	"objc" => "kalyptusCxxToObjc", "ruby" => "kalyptusCxxToRuby",
	"smoke" => "kalyptusCxxToSmoke", "csharp" => "kalyptusCxxToCSharp",
        "ECMA" => "kalyptusCxxToECMA", "pascal" => "kalyptusCxxToPas" );

# these are for expansion of method flags
%flagnames = ( v => 'virtual', 's' => 'static', p => 'pure',
	c => 'const', l => 'slot', i => 'inline', n => 'signal' );

%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 <[email protected]>, 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,
	"help|h", 	\&show_usage,
	"version|v|V", 	\&show_version,
	"private|p",	\$doPrivate,
	"libdir|L=s",	\$libdir,
	"xref|l=s",	\@libs,
	"classes|c=s",    \@includeclasses,

	"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 ($#includeclasses>=0)
{
    $includeclasses = join (" ", @includeclasses);
    print "Using Classes: $includeclasses\n" unless $quiet;
}

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_NO_* symbols and compile the corresponding RE
# Otherwise, compile the default ones. Used for filtering in readCxxLine.
if ( my @qt_defines = map { ($_=~m/^QT_NO_(.*)/)[0] } keys %defines)
{
    my $regexp = "m/^#\\s*ifn?def\\s+QT_NO_(?:" . join('|', map { "\$qt_defines[$_]" } 0..$#qt_defines).")/o";
    $match_qt_defines = eval "sub { my \$s=shift;
                                   \$s=~/^#\\s*if(n)?def QT_NO/ || 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();

# work out libdir. This is created by kdocLib:writeDoc when
# required.
$libdir = $ENV{HOME}."/.kalyptus" unless $libdir ne "";


######
###### main program
######
	readLibraries();
	parseFiles();

	if ( $parseonly ) {
		print "\n\tParse Tree\n\t------------\n\n";
		kdocAstUtil::dumpAst( $rootNode );
	}
	else {
		writeDocumentation();
		writeLibrary() unless $libname eq "";
	}

	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 readLibraries
{
	return if $#libs < 0;

	require kdocLib;
	foreach my $lib ( @libs ) {
		print "$exe: reading lib: $lib\n" unless $quiet;

		my $relpath = exists $options{url} ? 
			$options{url} : $outputdir;
		kdocLib::readLibrary( \&getRoot, $lib, $libdir, $relpath );
	}
}

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 "$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;

		# 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::linkNamespaces( $node );
		kdocAstUtil::makeInherit( $node, $node );
		kdocAstUtil::linkReferences( $node, $node );
		kdocAstUtil::calcStats( \%stats, $node, $node );

		# write
		no strict "refs";
		foreach my $format ( @formats_wanted ) {
			my $pack = $formats{ $format };
			require $pack.".pm";

			print "Generating bindings for $format ",
				"language...\n" unless $quiet;

			my $f = "$pack\::writeDoc";
			&$f( $libname, $node, $outputdir, \%options );
		}
	}
}

sub writeLibrary
{
	if( $libname ne "" ) {
		require kdocLib;
		foreach my $lang ( keys %rootNodes ) {
			my $node = $rootNodes{ $lang };
			kdocLib::writeDoc( $libname, $node, $lang, $libdir,
					$outputdir, $options{url},
					exists $options{compress} ? 1 : 0 );
		}
	}
}

###### 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*K_SYCOCATYPE/     # and K_SYCOCA stuff
                        || $p =~ /^\s*K_SYCOCAFACTORY/  #
                        || $p =~ /^\s*K_DCOP/           # and DCOP stuff
                        || $p =~ /^\s*KSVG_/            # and KSVG stuff ;)
			);

		# 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\(QT_THREAD_SUPPORT/ or
				     $p =~ m/^#\s*else/ or
				     $p =~ m/^#\s*if\s+defined\(Q_FULL_TEMPLATE_INSTANTIATION/ 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 ) = "";

	if( !defined $l ) {
		return undef;
	}
	elsif ( $l =~ /^\s*(private|public|protected|signals)
		(\s+\w+)?\s*:/x ) { # access specifier
		$declNodeType = "a";

		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 );
	}

	# 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*Q[A-Z_]*EXPORT[A-Z_]*)?
					(?:\s*Q_PACKED)?
					(?:\s*Q_REFCOUNT)?
					\s+([\w_]+                        # 3 name
							(?:<[\w_ :,]+?>)?		  # maybe explicit template
									#    (eat chars between <> non-hungry)
							(?:::[\w_]+)*                 #   maybe nested
					   )
					(.*?)                             # 4 inheritance
					([;{])/xs ) {                     # 5 rest

		print "Class: [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n" if $debug;
		my ( $tmpl, $ntype, $name, $rest, $endtag ) =
			( $1, $2, $3, $4, $5 );

		if ($includeclasses)
		{
		    if (! ($includeclasses =~ /$name/) )
		    {
			return 1;
			
		    }
		}

		my @inherits = ();

		$tmpl =~ s/<(.*)>/$1/ if $tmpl ne "";

		if(  $rest =~ /^\s*:\s*/ ) {
			# inheritance 
			$rest = $';
			@inherits = parseInheritance( $rest );
		}

		$newNode = newClass( $tmpl, $ntype, 
			$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*([^=]+?(?:operator\s*(?:\(\)|.?=)\s*)?) # ret+nm
		\( (.*?) \)		# parameters
		\s*((?:const)?)\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;

		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 = 0;
	}
	# end of an in-block declaration
	elsif ( $decl =~ /^\s*}\s*(.*?)\s*;\s*$/ ) {

		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;
		}

		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
	elsif ( $decl =~ /template\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 = $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, name, endTag, @inheritlist

	Handles a class declaration (also fwd decls).

=cut

sub newClass
{
	my( $tmplArgs, $cNodeType, $name, $endTag ) = @_;

	my $access = "private";
	$access = "public" if $cNodeType ne "class";

	# try to find an exisiting node, or create a new one
	my $oldnode = kdocAstUtil::findRef( $cNode, $name );
	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 );
			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 );

	$node->AddProp( "KidAccess", $access );
	$node->AddProp( "Tmpl", $tmplArgs ) unless $tmplArgs eq "";

	if ( !defined $oldnode ) {
		kdocAstUtil::attachChild( $cNode, $node );
	}

	# inheritance

	foreach my $ances ( splice (@_, 4) ) {
		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}\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

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+/ );

	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;
		}
	}
	else {
		# Within current class/global
	}


	# flags

	my $flags = "";

	if( $retType =~ /static/ ) {
		$flags .= "s";
		$retType =~ s/static//g;
	}

	if( $const ) {
		$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";
	}

	if ( $parent->{KidAccess} =~ /slot/ ) {
		$flags .= "l";
	}
	elsif ( $parent->{KidAccess} =~ /signal/ ) {
		$flags .= "n";
	}

	$retType =~ s/Q_EXPORT\s*//;
	$retType =~ s/inline\s+//;
	$retType =~ s/^\s*//g;
	$retType =~ s/\s*$//g;
	
	# 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 <[email protected]>
=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 *, & and ','
	$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 *

		# The RE below reads as: = ( string constant or char
		# or some word/number, with optional OR'ed or +'ed flags, and/or function call ).
		if ( $arg =~ s/\s*=\s*(("[^\"]*")|(\'.\')|(([-\w:~]*)\s*([\|\+-]*\s*\w*\s*)*(\(\w*\))?))// ) {
			$defaultparam = $1;
		}

		# Separate arg type from arg name, if the latter is specified
		if ( $arg =~ /(.*)\s+(\w+)\s*$/ ) {
		    $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)?/);

	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_usage

	Display usage information and quit.

=cut

sub show_usage
{
print<<EOF;
usage:
	$exe [options] [-f format] [-d outdir] [-n name] files... [-llib..]

See the man page kdoc[1] for more info.
EOF
	exit 1;
}


=head2 show_version

	Display short version information and quit.

=cut

sub show_version
{
	die "$exe: $Version (c) Sirtaj S. Kang <taj\@kde.org>\n";
}