home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / apps / dcopidlng / kalyptus < prev    next >
Encoding:
Text File  |  2005-09-10  |  38.1 KB  |  1,613 lines
  1. #!/usr/bin/perl -I/Users/duke/src/kde/kdebindings/kalyptus
  2. # -*- indent-tabs-mode: t; c-basic-offset: 4; tab-width: 4 -*-
  3.  
  4. # KDOC -- C++ and CORBA IDL interface documentation tool.
  5. # Sirtaj Singh Kang <taj@kde.org>, Jan 1999.
  6. # $Id: kalyptus 383034 2005-01-27 22:10:22Z dfaure $
  7.  
  8. # All files in this project are distributed under the GNU General
  9. # Public License. This is Free Software.
  10.  
  11. require 5.000;
  12.  
  13. use Carp;
  14. use Getopt::Long;
  15. use File::Basename;
  16. use strict;
  17.  
  18. use Ast;
  19.  
  20. use kdocUtil;
  21. use kdocAstUtil;
  22. use kdocParseDoc;
  23.  
  24. use vars qw/ %rootNodes $declNodeType @includes_list %options @formats_wanted $allow_k_dcop_accessors
  25.     $skipInternal %defines $defines $match_qt_defines
  26.     $libname $outputdir $parse_global_space $striphpath $doPrivate $readstdin
  27.     $Version $quiet $debug $debuggen $parseonly $currentfile $cSourceNode $exe
  28.     %formats %flagnames @allowed_k_dcop_accesors $allowed_k_dcop_accesors_re $rootNode 
  29.     @classStack $cNode $globalSpaceClassName
  30.     $lastLine $docNode @includes $cpp $defcppcmd $cppcmd $docincluded
  31.     $inExtern $inNamespace %stats %definitions @inputqueue @codeqobject /;
  32.  
  33. ## globals
  34.  
  35. %rootNodes = ();            # root nodes for each file type
  36. $declNodeType = undef;            # last declaration type
  37.  
  38. @includes_list = ();            # list of files included from the parsed .h
  39.  
  40. # All options
  41.  
  42. %options = ();                # hash of options (set getopt below)
  43. @formats_wanted = ();
  44.  
  45. $libname = "";
  46. $outputdir = ".";
  47.  
  48. $striphpath = 0;
  49.  
  50. $doPrivate = 0;
  51. $Version = "0.9";
  52.  
  53. $quiet = 0;
  54. $debug = 0;
  55. $debuggen = 0;
  56. $parseonly = 0;
  57. $globalSpaceClassName = "QGlobalSpace";
  58.  
  59. $currentfile = "";
  60.  
  61. $cpp = 0;
  62. $defcppcmd = "g++ -Wp,-C -E";
  63. $cppcmd = "";
  64.  
  65. $exe = basename $0;
  66.  
  67. @inputqueue = ();
  68. @codeqobject = split "\n", <<CODE;
  69. public:
  70.     virtual QMetaObject *metaObject() const;
  71.     virtual const char *className() const;
  72.     virtual void* qt_cast( const char* );
  73.     virtual bool qt_invoke( int, QUObject* );
  74.     virtual bool qt_emit( int, QUObject* );
  75.     virtual bool qt_property( int, int, QVariant* );
  76.     static QMetaObject* staticMetaObject();
  77.     QObject* qObject();
  78.     static QString tr( const char *, const char * = 0 );
  79.     static QString trUtf8( const char *, const char * = 0 );
  80. private:
  81. CODE
  82.  
  83. # Supported formats
  84. %formats = ( "dcopidl" => "kalyptusCxxToDcopIDL" );
  85.  
  86. # these are for expansion of method flags
  87. %flagnames = ( v => 'virtual', 's' => 'static', p => 'pure',
  88.     c => 'const', l => 'slot', i => 'inline', n => 'signal',
  89.      d => 'k_dcop', z => 'k_dcop_signals', y => 'k_dcop_hidden' );
  90.  
  91. @allowed_k_dcop_accesors = qw(k_dcop k_dcop_hidden k_dcop_signals);
  92. $allowed_k_dcop_accesors_re = join("|", @allowed_k_dcop_accesors);
  93.  
  94. %definitions = {
  95.     _STYLE_CDE => '',
  96.     _STYLE_MOTIF => '',
  97.     _STYLE_MOTIF_PLUS => '',
  98.     PLUS => '',
  99.     _STYLE_PLATINUM => '',
  100.     _STYLE_SGI => '',
  101.     _STYLE_WINDOWS => '',
  102.     QT_STATIC_CONST => 'static const',
  103.     Q_EXPORT => '',
  104.     Q_REFCOUNT => '',
  105.     QM_EXPORT_CANVAS => '',
  106.     QM_EXPORT_DNS => '',
  107.     QM_EXPORT_ICONVIEW => '',
  108.     QM_EXPORT_NETWORK => '',
  109.     QM_EXPORT_SQL => '',
  110.     QM_EXPORT_WORKSPACE => '',
  111.     QT_NO_REMOTE => 'QT_NO_REMOTE',
  112.     QT_ACCESSIBILITY_SUPPORT => 'QT_ACCESSIBILITY_SUPPORT',
  113.     Q_WS_X11 => 'Q_WS_X11',
  114.     Q_DISABLE_COPY => 'Q_DISABLE_COPY',
  115.     Q_WS_QWS => 'undef',
  116.     Q_WS_MAC => 'undef',
  117.     Q_OBJECT => <<'CODE',
  118. public:
  119.     virtual QMetaObject *metaObject() const;
  120.     virtual const char *className() const;
  121.     virtual bool qt_invoke( int, QUObject* );
  122.     virtual bool qt_emit( int, QUObject* );
  123.     static QString tr( const char *, const char * = 0 );
  124.     static QString trUtf8( const char *, const char * = 0 );
  125. private:
  126. CODE
  127. };
  128.  
  129. =head1 KDOC -- Source documentation tool
  130.  
  131.     Sirtaj Singh Kang <taj@kde.org>, Dec 1998.
  132.  
  133. =cut
  134.  
  135. # read options
  136.  
  137. Getopt::Long::config qw( no_ignore_case permute bundling auto_abbrev );
  138.  
  139. GetOptions( \%options,
  140.     "format|f=s", \@formats_wanted,
  141.     "url|u=s",
  142.     "skip-internal", \$skipInternal,
  143.     "skip-deprecated|e",
  144.     "document-all|a",
  145.     "compress|z",
  146.     # HTML options
  147.     "html-cols=i",
  148.     "html-logo=s",
  149.  
  150.     "strip-h-path",    \$striphpath,
  151.     "outputdir|d=s", \$outputdir,
  152.     "stdin|i",    \$readstdin,
  153.     "name|n=s",    \$libname,
  154.     "version|v|V",     \&show_version,
  155.     "private|p",    \$doPrivate,
  156.     "globspace",    \$parse_global_space,
  157.     "allow_k_dcop_accessors", \$allow_k_dcop_accessors,
  158.  
  159.     "cpp|P",    \$cpp,
  160.     "docincluded",  \$docincluded,
  161.     "cppcmd|C=s",    \$cppcmd,
  162.     "includedir|I=s", \@includes,
  163.     "define=s", \%defines, # define a single preprocessing symbol
  164.     "defines=s", \$defines, # file containing preprocessing symbols, one per line
  165.  
  166.     "quiet|q",    \$quiet,
  167.     "debug|D",    \$debug, # debug the parsing
  168.     "debuggen",    \$debuggen, # debug the file generation
  169.     "parse-only",    \$parseonly )
  170.         || exit 1;
  171.  
  172. $| = 1 if $debug or $debuggen;
  173.  
  174. # preprocessor settings
  175.  
  176. if ( $cppcmd eq "" ) {
  177.     $cppcmd = $defcppcmd;
  178. }
  179. else {
  180.     $cpp = 1;
  181. }
  182.  
  183. if ( $#includes >= 0 && !$cpp ) {
  184.     die "$exe: --includedir requires --cpp\n";
  185. }
  186.  
  187. # Check output formats. HTML is the default
  188. if( $#formats_wanted < 0 ) {
  189.     push @formats_wanted, "java";
  190. }
  191.  
  192. foreach my $format ( @formats_wanted ) {
  193.     die "$exe: unsupported format '$format'.\n"
  194.         if !defined $formats{$format};
  195. }
  196.  
  197. if( $defines )
  198. {
  199.     open( DEFS, $defines ) or die "Couldn't open $defines: $!\n";
  200.     my @defs = <DEFS>;
  201.     chomp @defs;
  202.     close DEFS;
  203.     foreach (@defs)
  204.     {
  205.         $defines{ $_ } = 1 unless exists $defines{ $_ };
  206.     }
  207. }
  208.  
  209. # Check the %defines hash for QT_* symbols and compile the corresponding RE
  210. # Otherwise, compile the default ones. Used for filtering in readCxxLine.
  211. if ( my @qt_defines = map { ($_=~m/^QT_(.*)/)[0] } keys %defines)
  212. {
  213.     my $regexp = "m/^#\\s*ifn?def\\s+QT_(?:" . join('|', map { "\$qt_defines[$_]" } 0..$#qt_defines).")/o";
  214.     $match_qt_defines = eval "sub { my \$s=shift;
  215.                                    \$s=~/^#\\s*if(n)?def/ || return 0;
  216.                                    if(!\$1) { return \$s=~$regexp ? 0:1 }
  217.                                    else { return \$s=~$regexp ? 1:0 }
  218.                                   }";
  219.     die if $@;
  220. }
  221. else
  222. {
  223.     $match_qt_defines = eval qú
  224.     sub
  225.     {
  226.         my $s = shift;
  227.         $s =~ m/^\#\s*ifndef\s+QT_NO_(?:REMOTE| # not in the default compile options
  228.                                         NIS|    #  ...
  229.                                         XINERAMA|
  230.                                         IMAGEIO_(?:MNG|JPEG)|
  231.                                         STYLE_(?:MAC|INTERLACE|COMPACT)
  232.                                      )/x;
  233.     }
  234.     ú;
  235.     die if $@;
  236. }
  237. # Check if there any files to process.
  238. # We do it here to prevent the libraries being loaded up first.
  239.  
  240. checkFileArgs();
  241.  
  242. ######
  243. ###### main program
  244. ######
  245.     parseFiles();
  246.  
  247.     if ( $parseonly ) {
  248.         print "\n\tParse Tree\n\t------------\n\n";
  249.         kdocAstUtil::dumpAst( $rootNode );
  250.     }
  251.     else {
  252.         writeDocumentation();
  253.     }
  254.  
  255.     kdocAstUtil::printDebugStats() if $debug;
  256.  
  257.     exit 0;
  258. ######
  259.  
  260. sub checkFileArgs
  261. {
  262.     return unless $#ARGV < 0;
  263.  
  264.     die "$exe: no input files.\n" unless $readstdin;
  265.  
  266.     # read filenames from standard input
  267.         while (<STDIN>) {
  268.         chop;
  269.         $_ =~ s,\\,/,g;    # back to fwd slash (for Windows)
  270.         foreach my $file ( split( /\s+/, $_ ) ) {
  271.             push @ARGV, $file;
  272.         }
  273.     }
  274. }
  275.  
  276. sub parseFiles
  277. {
  278.     foreach $currentfile ( @ARGV ) {
  279.         my $lang = "CXX";
  280.  
  281.         if ( $currentfile =~ /\.idl\s*$/ ) {
  282.             # IDL file
  283.             $lang = "IDL";
  284.         }
  285.  
  286.         # assume cxx file
  287.         if( $cpp ) {
  288.             # pass through preprocessor
  289.             my $cmd = $cppcmd;
  290.             foreach my $dir ( @includes ) {
  291.                 $cmd .= " -I $dir ";
  292.             }
  293.  
  294.             $cmd .= " -DQOBJECTDEFS_H $currentfile";
  295.  
  296.             open( INPUT, "$cmd |" )
  297.                 || croak "Can't preprocess $currentfile";
  298.         }
  299.         else {
  300.             open( INPUT, "$currentfile" ) 
  301.                 || croak "Can't read from $currentfile";
  302.         }
  303.  
  304.         print STDERR "$exe: processing $currentfile\n" unless $quiet;
  305.  
  306.         # reset vars
  307.         $rootNode = getRoot( $lang );
  308.  
  309.  
  310.         # add to file lookup table
  311.         my $showname = $striphpath ? basename( $currentfile )
  312.                         : $currentfile;
  313.         $cSourceNode = Ast::New( $showname );
  314.         $cSourceNode->AddProp( "NodeType", "source" );
  315.         $cSourceNode->AddProp( "Path", $currentfile );
  316.         $rootNode->AddPropList( "Sources", $cSourceNode );
  317.  
  318.         # reset state
  319.         @classStack = ();
  320.         $cNode = $rootNode;
  321.         $inExtern = 0;
  322.         $inNamespace = 0;
  323.  
  324.         # parse
  325.         my $k = undef;
  326.         while ( defined ($k = readDecl()) ) {
  327.             print "\nDecl: <$k>[$declNodeType]\n" if $debug;
  328.             if( identifyDecl( $k ) && $k =~ /{/ ) {
  329.                 readCxxCodeBlock();
  330.             } 
  331.         }
  332.         close INPUT;
  333.     }
  334. }
  335.  
  336.  
  337. sub writeDocumentation
  338. {
  339.     foreach my $node ( values %rootNodes ) {
  340.         # postprocess
  341.         kdocAstUtil::makeInherit( $node, $node );
  342.  
  343.         # write
  344.         no strict "refs";
  345.         foreach my $format ( @formats_wanted ) {
  346.             my $pack = $formats{ $format };
  347.             require $pack.".pm";
  348.  
  349.             print STDERR "Generating bindings for $format ",
  350.                          "language...\n" if $debug;
  351.  
  352.             my $f = "$pack\::writeDoc";
  353.             &$f( $libname, $node, $outputdir, \%options );
  354.         }
  355.     }
  356. }
  357.  
  358. ###### Parser routines
  359.  
  360. =head2 readSourceLine
  361.  
  362.     Returns a raw line read from the current input file.
  363.     This is used by routines outside main, since I don t know
  364.     how to share fds.
  365.  
  366. =cut
  367.  
  368. sub readSourceLine
  369. {
  370.     return <INPUT>;
  371. }
  372.  
  373. =head2 readCxxLine
  374.  
  375.     Reads a C++ source line, skipping comments, blank lines,
  376.     preprocessor tokens and the Q_OBJECT macro
  377.  
  378. =cut
  379.  
  380. sub readCxxLine
  381. {
  382.     my( $p );
  383.     my( $l );
  384.     
  385.     while( 1 ) {
  386.         $p = shift @inputqueue || <INPUT>;
  387.         return undef if !defined ($p);
  388.  
  389.         $p =~ s#//.*$##g;            # C++ comment
  390.         $p =~ s#/\*(?!\*).*?\*/##g;        # C comment
  391.  
  392.         # join all multiline comments
  393.         if( $p =~ m#/\*(?!\*)#s ) {
  394.             # unterminated comment
  395. LOOP:
  396.             while( defined ($l = <INPUT>) ) {
  397.                 $l =~ s#//.*$##g;        # C++ comment
  398.                 $p .= $l;
  399.                 $p =~ s#/\*(?!\*).*?\*/##sg;    # C comment
  400.                 last LOOP unless $p =~ m#(/\*(?!\*))|(\*/)#sg;
  401.             }
  402.         }
  403.  
  404.         if ( $p =~ /^\s*Q_OBJECT/ ) {
  405.             push @inputqueue, @codeqobject;
  406.             next;
  407.         }
  408.         # Hack, waiting for real handling of preprocessor defines
  409.         $p =~ s/QT_STATIC_CONST/static const/;
  410.         $p =~ s/KSVG_GET/KJS::Value get();/;
  411.         $p =~ s/KSVG_BASECLASS_GET/KJS::Value get();/;
  412.         $p =~ s/KSVG_BRIDGE/KJS::ObjectImp *bridge();/;
  413.         $p =~ s/KSVG_FORWARDGET/KJS::Value getforward();/;
  414.         $p =~ s/KSVG_PUT/bool put();/;
  415.         $p =~ s/KSVG_FORWARDPUT/bool putforward();/;
  416.         $p =~ s/KSVG_BASECLASS/virtual KJS::Value cache();/;
  417.         if ( $p =~ m/KSVG_DEFINE_PROTOTYPE\((\w+)\)/ ) {
  418.             push @inputqueue, split('\n',"namespace KSVG {\nclass $1 {\n};\n};");
  419.         }
  420.  
  421.         next if ( $p =~ /^\s*$/s );         # blank lines
  422. #            || $p =~ /^\s*Q_OBJECT/        # QObject macro
  423. #            );
  424. #
  425.  
  426.         next if ( $p =~ /^\s*Q_ENUMS/            # ignore Q_ENUMS
  427.                         || $p =~ /^\s*Q_PROPERTY/        # and Q_PROPERTY
  428.                         || $p =~ /^\s*Q_OVERRIDE/        # and Q_OVERRIDE
  429.                         || $p =~ /^\s*Q_SETS/
  430.                         || $p =~ /^\s*Q_DUMMY_COMPARISON_OPERATOR/
  431.                         || $p =~ /^\s*K_SYCOCATYPE/        # and K_SYCOCA stuff
  432.                         || $p =~ /^\s*K_SYCOCAFACTORY/    #
  433.                         || $p =~ /^\s*KSVG_/            # and KSVG stuff ;)
  434.                         || $p =~ /^\s*KDOM_/
  435.             );
  436.  
  437.         push @includes_list, $1 if $p =~ /^#include\s+<?(.*?)>?\s*$/;
  438.  
  439.         # remove all preprocessor macros
  440.         if( $p =~ /^\s*#\s*(\w+)/ ) {
  441.             # Handling of preprocessed sources: skip anything included from
  442.             # other files, unless --docincluded was passed.
  443.             if (!$docincluded && $p =~ /^\s*#\s*[0-9]+\s*\".*$/ 
  444.                     && not($p =~ /\"$currentfile\"/)) {
  445.                 # include file markers
  446.                 while( <INPUT> ) {
  447.                     last if(/\"$currentfile\"/);
  448.                     print "Overread $_" if $debug;
  449.                 };
  450.                 print "Cont: $_" if $debug;
  451.             }
  452.             else {
  453.                 # Skip platform-specific stuff, or #if 0 stuff
  454.                 # or #else of something we parsed (e.g. for QKeySequence)
  455.                 if ( $p =~ m/^#\s*ifdef\s*Q_WS_/ or
  456.                      $p =~ m/^#\s*if\s+defined\(Q_WS_/ or
  457.                      $p =~ m/^#\s*if\s+defined\(Q_OS_/ or
  458.                      $p =~ m/^#\s*if\s+defined\(Q_CC_/ or
  459.                      $p =~ m/^#\s*if\s+defined\(QT_THREAD_SUPPORT/ or
  460.                      $p =~ m/^#\s*else/ or
  461.                      $p =~ m/^#\s*if\s+defined\(Q_FULL_TEMPLATE_INSTANTIATION/ or
  462.                      $p =~ m/^#\s*ifdef\s+CONTAINER_CUSTOM_WIDGETS/ or
  463.                      &$match_qt_defines( $p ) or
  464.                      $p =~ m/^#\s*if\s+0\s+/ ) {
  465.                      my $if_depth = 1;
  466.                      while ( defined $p && $if_depth > 0 ) {
  467.                      $p = <INPUT>;
  468.                      last if !defined $p;
  469.                      $if_depth++ if $p =~ m/^#\s*if/;
  470.                      $if_depth-- if $p =~ m/^#\s*endif/;
  471.                      # Exit at #else in the #ifdef QT_NO_ACCEL/#else/#endif case
  472.                      last if $if_depth == 1 && $p =~ m/^#\s*else\s/;
  473.                      #ignore elif for now
  474.                      print "Skipping ifdef'ed line: $p" if $debug;
  475.                      }
  476.                 }
  477.  
  478.                 # multiline macros
  479.                 while ( defined $p && $p =~ m#\\\s*$# ) {
  480.                     $p = <INPUT>;
  481.                 }
  482.             }
  483.             next;
  484.         }
  485.  
  486.         $lastLine = $p;
  487.         return $p;
  488.     }
  489. }
  490.  
  491. =head2 readCxxCodeBlock
  492.  
  493.     Reads a C++ code block (recursive curlies), returning the last line
  494.     or undef on error.
  495.  
  496.     Parameters: none
  497.  
  498. =cut
  499.  
  500. sub readCxxCodeBlock
  501. {
  502. # Code: begins in a {, ends in }\s*;?
  503. # In between: cxx source, including {}
  504.     my ( $count ) = 0;
  505.     my $l = undef;
  506.     
  507.     if ( defined $lastLine ) {
  508.         print "lastLine: '$lastLine'" if $debug;
  509.  
  510.         my $open = kdocUtil::countReg( $lastLine, "{" );
  511.         my $close = kdocUtil::countReg( $lastLine, "}" );
  512.         $count = $open - $close;
  513.  
  514.         return $lastLine if ( $open || $close) && $count == 0;
  515.     }
  516.  
  517.     # find opening brace
  518.     if ( $count == 0 ) {
  519.         while( $count == 0 ) {
  520.             $l = readCxxLine();
  521.             return undef if !defined $l;
  522.             $l =~ s/\\.//g;
  523.             $l =~ s/'.?'//g;
  524.             $l =~ s/".*?"//g;
  525.  
  526.             $count += kdocUtil::countReg( $l, "{" );
  527.             print "c ", $count, " at '$l'" if $debug;
  528.         }
  529.         $count -= kdocUtil::countReg( $l, "}" );
  530.     }
  531.  
  532.     # find associated closing brace
  533.     while ( $count > 0 ) {
  534.         $l = readCxxLine();
  535.         croak "Confused by unmatched braces" if !defined $l;
  536.         $l =~ s/\\.//g;
  537.         $l =~ s/'.?'//g;
  538.         $l =~ s/".*?"//g;
  539.  
  540.         my $add = kdocUtil::countReg( $l, "{" );
  541.         my $sub = kdocUtil::countReg( $l, "}" );
  542.         $count += $add - $sub;
  543.  
  544.         print "o ", $add, " c ", $sub, " at '$l'" if $debug;
  545.     }
  546.  
  547.     undef $lastLine;
  548.     return $l;
  549. }
  550.  
  551. =head2 readDecl
  552.  
  553.     Returns a declaration and sets the $declNodeType variable.
  554.  
  555.     A decl starts with a type or keyword and ends with [{};]
  556.     The entire decl is returned in a single line, sans newlines.
  557.  
  558.     declNodeType values: undef for error, "a" for access specifier,
  559.     "c" for doc comment, "d" for other decls.
  560.  
  561.     readCxxLine is used to read the declaration.
  562.  
  563. =cut
  564.  
  565. sub readDecl
  566. {
  567.     undef $declNodeType;
  568.     my $l = readCxxLine();
  569.     my ( $decl ) = "";
  570.  
  571.     my $allowed_accesors = "private|public|protected|signals";
  572.     $allowed_accesors .= "|$allowed_k_dcop_accesors_re" if $allow_k_dcop_accessors;
  573.  
  574.     if( !defined $l ) {
  575.         return undef;
  576.     }
  577.     elsif ( $l =~ /^\s*($allowed_accesors)
  578.                (\s+\w+)?\s*:/x) { # access specifier
  579.         $declNodeType = "a";
  580.         return $l;
  581.     }
  582.     elsif ( $l =~ /K_DCOP/ ) {
  583.         $declNodeType = "k";
  584.         return $l;
  585.     }
  586.     elsif ( $l =~ m#^\s*/\*\*# ) {    # doc comment
  587.         $declNodeType = "c";
  588.         return $l;
  589.     }
  590.  
  591.     do {
  592.         $decl .= $l;
  593.  
  594.         if ( $l =~ /[{};]/ ) {
  595.             $decl =~ s/\n/ /gs;
  596.             $declNodeType = "d";
  597.             return $decl;
  598.         }
  599.         return undef if !defined ($l = readCxxLine());
  600.  
  601.     } while ( 1 );
  602. }
  603.  
  604. #### AST Generator Routines
  605.  
  606. =head2 getRoot
  607.  
  608.     Return a root node for the given type of input file.
  609.  
  610. =cut
  611.  
  612. sub getRoot
  613. {
  614.     my $type = shift;
  615.     carp "getRoot called without type" unless defined $type;
  616.  
  617.     if ( !exists $rootNodes{ $type } ) {
  618.         my $node = Ast::New( "Global" );    # parent of all nodes
  619.         $node->AddProp( "NodeType", "root" );
  620.         $node->AddProp( "RootType", $type );
  621.         $node->AddProp( "Compound", 1 );
  622.         $node->AddProp( "KidAccess", "public" );
  623.  
  624.         $rootNodes{ $type } = $node;
  625.     }
  626.     print "getRoot: call for $type\n" if $debug;
  627.  
  628.     return $rootNodes{ $type };
  629. }
  630.  
  631. =head2 identifyDecl
  632.  
  633.     Parameters: decl
  634.  
  635.     Identifies a declaration returned by readDecl. If a code block
  636.     needs to be skipped, this subroutine returns a 1, or 0 otherwise.
  637.  
  638. =cut
  639.  
  640. sub identifyDecl
  641. {
  642.     my( $decl ) = @_;
  643.  
  644.     my $newNode = undef;
  645.     my $skipBlock = 0;
  646.  
  647.     # Doc comment
  648.     if ( $declNodeType eq "c" ) {
  649.         $docNode = kdocParseDoc::newDocComment( $decl );
  650.  
  651.         # if it's the main doc, it is attached to the root node
  652.         if ( defined $docNode->{LibDoc} ) {
  653.             kdocParseDoc::attachDoc( $rootNode, $docNode,
  654.                 $rootNode );
  655.             undef $docNode;
  656.         }
  657.  
  658.     }
  659.     elsif ( $declNodeType eq "a" ) {
  660.         newAccess( $decl );
  661.     }
  662.     elsif ( $declNodeType eq "k" ) {
  663.         $cNode->AddProp( "DcopExported", 1 );
  664.     }
  665.  
  666.     # Typedef struct/class
  667.     elsif ( $decl =~ /^\s*typedef
  668.             \s+(struct|union|class|enum)
  669.             \s*([_\w\:]*)
  670.             \s*([;{]) 
  671.             /xs ) {
  672.         my ($type, $name, $endtag, $rest ) = ($1, $2, $3, $' );
  673.         $name = "--" if $name eq "";
  674.  
  675.         warn "typedef '$type' n:'$name'\n" if $debug;
  676.  
  677.         if ( $rest =~ /}\s*([\w_]+(?:::[\w_])*)\s*;/ ) {
  678.             # TODO: Doesn't parse members yet!
  679.             $endtag = ";";
  680.             $name = $1;
  681.         }
  682.  
  683.         $newNode = newTypedefComp( $type, $name, $endtag );
  684.     }
  685.  
  686.     # Typedef
  687.     elsif ( $decl =~ /^\s*typedef\s+
  688.             (?:typename\s+)?    # `typename' keyword
  689.             (.*?\s*[\*&]?)        # type
  690.             \s+([-\w_\:]+)        # name
  691.             \s*((?:\[[-\w_\:<>\s]*\])*)    # array
  692.             \s*[{;]\s*$/xs  ) {
  693.  
  694.         print "Typedef: <$1 $3> <$2>\n" if $debug;
  695.         $newNode = newTypedef( $1." ".$3, $2 );
  696.     }
  697.  
  698.     # Enum
  699.     elsif ( $decl =~ /^\s*enum\s+([-\w_:]*)?\s*\{(.*)/s  ) {
  700.  
  701.         print "Enum: <$1>\n" if $debug;
  702.         my $enumname = defined $2 ? $1 : "";
  703.  
  704.         $newNode = newEnum( $enumname );
  705.     }
  706.  
  707.     # Class/Struct
  708.     elsif ( $decl =~ /^\s*((?:template\s*<.*>)?)      # 1 template
  709.                     \s*(class|struct|union|namespace) # 2 struct type
  710.                     \s*([A-Z_]*EXPORT[A-Z_]*)?          # 3 export
  711.                     (?:\s*Q_PACKED)?
  712.                     (?:\s*Q_REFCOUNT)?
  713.                     \s+([\w_]+                          # 4 name
  714.                             (?:<[\w_ :,]+?>)?          # maybe explicit template
  715.                                     #     (eat chars between <> non-hungry)
  716.                             (?:::[\w_]+)*                  #      maybe nested
  717.                        )
  718.                     ([^\(]*?)                          # 5 inheritance
  719.                     ([;{])/xs ) {                      # 6 rest
  720.  
  721.         print "Class: => [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n\t[$6]\n" if $debug;
  722.         my ( $tmpl, $ntype, $export, $name, $rest, $endtag ) =
  723.             ( $1, $2, $3, $4, $5, $6 );
  724.  
  725.         if ($ntype eq 'namespace') {
  726.             if ($decl =~ /}/) {
  727.                 return 0;
  728.             }
  729.             # Set a flag to indicate we're in a multi-line namespace declaration
  730.             $inNamespace = 1;
  731.         }
  732.  
  733.  
  734.         my @inherits = ();
  735.  
  736.         $tmpl =~ s/<(.*)>/$1/ if $tmpl ne "";
  737.  
  738.         if(  $rest =~ /^\s*:\s*/ ) {
  739.             # inheritance 
  740.             $rest = $';
  741.             @inherits = parseInheritance( $rest );
  742.         }
  743.  
  744.         $newNode = newClass( $tmpl, $ntype, $export,
  745.             $name, $endtag, @inherits );
  746.     }
  747.     # IDL compound node
  748.     elsif( $decl =~ /^\s*(module|interface|exception) # struct type
  749.             \s+([-\w_]+)            # name
  750.             (.*?)                # inheritance?
  751.             ([;{])/xs ) {
  752.         
  753.         my ( $type, $name, $rest, $fwd, $complete ) 
  754.             = ( $1, $2, $3, $4 eq ";" ? 1 : 0,
  755.                 0 );
  756.         my @in = ();
  757.         print "IDL: [$type] [$name] [$rest] [$fwd]\n" if $debug;
  758.  
  759.         if( $rest =~ /^\s*:\s*/ ) {
  760.             $rest = $';
  761.             $rest =~ s/\s+//g;
  762.             @in = split ",", $rest;
  763.         }
  764.         if( $decl =~ /}\s*;/ ) {
  765.             $complete = 1;
  766.         }
  767.  
  768.         $newNode = newIDLstruct( $type, $name, $fwd, $complete, @in );
  769.     }
  770.     # Method
  771.     elsif ( $decl =~ /^\s*(?:(?:class|struct)\s*)?([^=]+?(?:operator\s*(?:\(\)|.?=)\s*)?) # ret+nm
  772.                       \( (.*?) \)        # parameters
  773.                       \s*((?:const)?)\s*
  774.                       (?:throw\s*\(.*?\))?
  775.                       \s*((?:=\s*0(?:L?))?)\s*    # Pureness. is "0L" allowed?
  776.                       \s*[;{]+/xs ) {    # rest
  777.  
  778.         my $tpn = $1; # type + name
  779.         my $params = $2;
  780.         # Remove constructor initializer, that's not in the params
  781.         if ( $params =~ /\s*\)\s*:\s*/ ) {
  782.             # Hack: first .* made non-greedy for QSizePolicy using a?(b):c in ctor init
  783.             $params =~ s/(.*?)\s*\)\s*:\s*.*$/$1/;
  784.         }
  785.  
  786.         my $const = $3 eq "" ? 0 : 1;
  787.         my $pure = $4 eq "" ? 0 : 1;
  788.         $tpn =~ s/\s+/ /g;
  789.         $params =~ s/\s+/ /g;
  790.  
  791.         print "Method: R+N:[$tpn]\n\tP:[$params]\n\t[$const]\n" if $debug;
  792.  
  793.         if ( $tpn =~ /((?:\w+\s*::\s*)?operator.*?)\s*$/    # operator
  794.                     || $tpn =~ /((?:\w*\s*::\s*~?)?[-\w:]+)\s*$/ ) { # normal
  795.                 my $name = $1;
  796.                 $tpn = $`;
  797.                 $newNode = newMethod( $tpn, $name, 
  798.                                 $params, $const, $pure );
  799.         }
  800.  
  801.         $skipBlock = 1; # FIXME check end token before doing this!
  802.     }
  803.     # Using: import namespace
  804.     elsif ( $decl =~ /^\s*using\s+namespace\s+(\w+)/ ) {
  805.         newNamespace( $1 );
  806.  
  807.     }
  808.  
  809.     # extern block
  810.     elsif ( $decl =~ /^\s*extern\s*"(.*)"\s*{/ ) {
  811.         $inExtern = 1 unless $decl =~ /}/;
  812.     }
  813.  
  814.     # Single variable
  815.     elsif ( $decl =~ /^
  816.             \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? )# type
  817.                 \s*(?:<.+>)?        # template
  818.                 \s*(?:[\&\*])?        # ptr or ref
  819.                 (?:\s*(?:const|volatile))* )
  820.             \s*([\w_:]+)            # name
  821.             \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array
  822.             \s*((?:=.*)?)            # value
  823.             \s*([;{])\s*$/xs ) {
  824.         my $type = $1;
  825.         my $name = $2;
  826.         my $arr  = $3;
  827.         my $val     = $4;
  828.         my $end     = $5;
  829.  
  830.         $type =~ s/\s+/ /g;
  831.  
  832.         if ( $type !~ /^friend\s+class\s*/ ) {
  833.             print "Var: [$name] type: [$type$arr] val: [$val]\n" 
  834.                 if $debug;
  835.  
  836.             $newNode = newVar( $type.$arr, $name, $val );
  837.         }
  838.  
  839.         $skipBlock = 1 if $end eq '{';
  840.     }
  841.  
  842.     # Multi variables
  843.     elsif ( $decl =~ m/^
  844.         \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? )    # type
  845.         \s*(?:<.+>)?)                        # template
  846.  
  847.         \s*( (?:\s*(?: [\&\*][\&\*\s]*)?     # ptr or ref
  848.             [\w_:]+)                        # name
  849.         \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array
  850.         \s*(?:,                                # extra vars
  851.             \s*(?: [\&\*][\&\*\s]*)?         # ptr or ref
  852.             \s*(?:[\w_:]+)                    # name
  853.             \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array
  854.             )* 
  855.         \s*(?:=.*)?)                        # value
  856.         \s*[;]/xs ) {
  857.  
  858.         my $type = $1;
  859.         my $names = $2;
  860.         my $end = $3;
  861.         my $doc = $docNode;
  862.  
  863.         print "Multivar: type: [$type] names: [$names] \n" if $debug;
  864.  
  865.         foreach my $vardecl ( split( /\s*,\s*/, $names ) ) {
  866.             next unless $vardecl =~ m/
  867.             \s*((?: [\&\*][\&\*\s]*)?)     # ptr or ref
  868.             \s*([\w_:]+)            # name
  869.             \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array
  870.             \s*((?:=.*)?)            # value
  871.                 /xs;
  872.             my ($ptr, $name, $arr, $val) = ($1, $2, $3, $4);
  873.  
  874.             print "Split: type: [$type$ptr$arr] ",
  875.                 " name: [$name] val: [$val] \n" if $debug;
  876.  
  877.             my $node = newVar( $type.$ptr.$arr, $name, $val );
  878.  
  879.             $docNode = $doc;    # reuse docNode for each
  880.             postInitNode( $node ) unless !defined $node;
  881.         }
  882.  
  883.         $skipBlock = 1 if $end eq '{';
  884.     }
  885.     # end of an "extern" block
  886.     elsif ( $decl =~ /^\s*}\s*$/ && $inExtern ) {
  887.         $inExtern = 0;
  888.     }
  889.     # end of an in-block declaration
  890.     elsif ( $decl =~ /^\s*}\s*(.*?)\s*;\s*$/ || ($decl =~ /^\s*}\s*$/ && $inNamespace) ) {
  891.  
  892.         if ( $cNode->{astNodeName} eq "--" ) {
  893.             # structure typedefs should have no name preassigned.
  894.             # If they do, then the name in 
  895.             # "typedef struct <name> { ..." is kept instead.
  896.             # TODO: Buglet. You should fix YOUR code dammit. ;)
  897.  
  898.  
  899.             $cNode->{astNodeName} = $1;
  900.             my $siblings = $cNode->{Parent}->{KidHash};
  901.             undef $siblings->{"--"};
  902.             $siblings->{ $1 } = $cNode;
  903.         }
  904.  
  905.         # C++ namespaces end with a '}', and not '};' like classes
  906.         if ($decl =~ /^\s*}\s*$/ ) {
  907.             $inNamespace = 0;
  908.         }
  909.  
  910.         if ( $#classStack < 0 ) {
  911.             confess "close decl found, but no class in stack!" ;
  912.             $cNode = $rootNode;
  913.         }
  914.         else {
  915.             $cNode = pop @classStack;
  916.             print "end decl: popped $cNode->{astNodeName}\n" 
  917.                 if $debug;
  918.         }
  919.     }
  920.     # unidentified block start
  921.     elsif ( $decl =~ /{/ ) {
  922.         print "Unidentified block start: $decl\n" if $debug;
  923.         $skipBlock = 1;
  924.     }
  925.     # explicit template instantiation, or friend template
  926.     elsif ( $decl =~ /(template|friend)\s+class\s+(?:Q[A-Z_]*EXPORT[A-Z_]*\s*)?\w+\s*<.*>\s*;/x ) {
  927.         # Nothing to be done with those.
  928.     }
  929.     else {
  930.  
  931.         ## decl is unidentified.
  932.         warn "Unidentified decl: $decl\n";
  933.     }
  934.  
  935.     # once we get here, the last doc node is already used.
  936.     # postInitNode should NOT be called for forward decls
  937.     postInitNode( $newNode ) unless !defined $newNode;
  938.  
  939.     return $skipBlock;
  940. }
  941.  
  942. sub postInitNode
  943. {
  944.     my $newNode = shift;
  945.  
  946.     carp "Cannot postinit undef node." if !defined $newNode;
  947.  
  948.     # The reasoning here:
  949.     # Forward decls never get a source node.
  950.     # Once a source node is defined, don't assign another one.
  951.  
  952.     if ( $newNode->{NodeType} ne "Forward" && !defined $newNode->{Source}) {
  953.         $newNode->AddProp( "Source", $cSourceNode );
  954.     } elsif ( $newNode->{NodeType} eq "Forward" ) {
  955.         if ($debug) {
  956.             print "postInit: skipping fwd: $newNode->{astNodeName}\n";
  957.         }
  958.         undef $docNode;
  959.         return;
  960.     }
  961.  
  962.     if( defined $docNode ) {
  963.         kdocParseDoc::attachDoc( $newNode, $docNode, $rootNode );
  964.         undef $docNode;
  965.     }
  966. }
  967.  
  968.  
  969. ##### Node generators
  970.  
  971. =head2 newEnum
  972.  
  973.     Reads the parameters of an enumeration.
  974.  
  975.     Returns the parameters, or undef on error.
  976.  
  977. =cut
  978.  
  979. sub newEnum
  980. {
  981.     my ( $enum ) = @_;
  982.     my $k = undef;
  983.     my $params = "";
  984.  
  985.     $k = $lastLine if defined $lastLine;
  986.  
  987.     if( defined $lastLine && $lastLine =~ /{/ ) {
  988.         $params = $';
  989.         if ( $lastLine =~ /}(.*?);/ ) {
  990.             return initEnum( $enum, $1, $params );
  991.         }
  992.     }
  993.  
  994.     while ( defined ( $k = readCxxLine() ) ) {
  995.         $params .= $k;
  996.  
  997.         if ( $k =~ /}(.*?);/ ) {
  998.             return initEnum( $enum, $1, $params );
  999.         }
  1000.     }
  1001.  
  1002.     return undef;
  1003. }
  1004.  
  1005. =head2 initEnum
  1006.  
  1007.     Parameters: name, (ref) params
  1008.  
  1009.     Returns an initialized enum node.
  1010.  
  1011. =cut
  1012.  
  1013. sub initEnum
  1014. {
  1015.     my( $name, $end, $params ) = @_;
  1016.  
  1017.     ($name = $end) if $name eq "" && $end ne "";
  1018.  
  1019.     $params =~ s#\s+# #sg; # no newlines
  1020.     $params =~ s#\s*/\*([^\*]/|\*[^/]|[^\*/])*\*/##g; # strip out comments
  1021.     $params = $1 if $params =~ /^\s*{?(.*)}/;
  1022.     print "$name params: [$params]\n" if $debug;
  1023.  
  1024.  
  1025.     my ( $node ) = Ast::New( $name );
  1026.     $node->AddProp( "NodeType", "enum" );
  1027.     $node->AddProp( "Params", $params );
  1028.     makeParamList( $node, $params, 1 ); # Adds the ParamList property containing the list of param nodes
  1029.     kdocAstUtil::attachChild( $cNode, $node );
  1030.  
  1031.     return $node;
  1032. }
  1033.  
  1034. =head2 newIDLstruct
  1035.  
  1036.     Parameters: type, name, forward, complete, inherits...
  1037.  
  1038.     Handles an IDL structure definition (ie module, interface,
  1039.     exception).
  1040.  
  1041. =cut
  1042.  
  1043. sub newIDLstruct
  1044. {
  1045.     my ( $type, $name, $fwd, $complete ) = @_;
  1046.  
  1047.     my $node = exists $cNode->{KidHash} ? 
  1048.         $cNode->{KidHash}->{ $name } : undef;
  1049.  
  1050.     if( !defined $node ) {
  1051.         $node = Ast::New( $name );
  1052.         $node->AddProp( "NodeType", $fwd ? "Forward" : $type );
  1053.         $node->AddProp( "KidAccess", "public" );
  1054.         $node->AddProp( "Compound", 1 ) unless $fwd;
  1055.         kdocAstUtil::attachChild( $cNode, $node );
  1056.     }
  1057.     elsif ( $fwd ) {
  1058.         # If we have a node already, we ignore forwards.
  1059.         return undef;
  1060.     }
  1061.     elsif ( $node->{NodeType} eq "Forward" ) {
  1062.         # we are defining a previously forward node.
  1063.         $node->AddProp( "NodeType", $type );
  1064.         $node->AddProp( "Compound", 1 );
  1065.         $node->AddProp( "Source", $cSourceNode );
  1066.     }
  1067.  
  1068.     # register ancestors.
  1069.     foreach my $ances ( splice ( @_, 4 ) ) {
  1070.         my $n = kdocAstUtil::newInherit( $node, $ances );
  1071.     }
  1072.  
  1073.     if( !( $fwd || $complete) ) {
  1074.         print "newIDL: pushing $cNode->{astNodeName},",
  1075.             " new is $node->{astNodeName}\n"
  1076.                 if $debug;
  1077.         push @classStack, $cNode;
  1078.         $cNode = $node;
  1079.     }
  1080.  
  1081.     return $node;
  1082. }
  1083.  
  1084. =head2 newClass
  1085.  
  1086.     Parameters: tmplArgs, cNodeType, export, name, endTag, @inheritlist
  1087.  
  1088.     Handles a class declaration (also fwd decls).
  1089.  
  1090. =cut
  1091.  
  1092. sub newClass
  1093. {
  1094.     my( $tmplArgs, $cNodeType, $export, $name, $endTag ) = @_;
  1095.  
  1096.     my $access = "private";
  1097.     $access = "public" if $cNodeType ne "class";
  1098.  
  1099.     # try to find an exisiting node, or create a new one
  1100.     # We need to make the fully-qualified-name otherwise findRef will look
  1101.     # for that classname in the global namespace
  1102.     # testcase: class Foo; namespace Bar { class Foo { ... } }
  1103.     my @parents;
  1104.     push @parents, kdocAstUtil::heritage($cNode) if (defined $cNode->{Parent});
  1105.     push @parents, $name;
  1106.     my $fullyQualifiedName = join "::", @parents;
  1107.     print "looking for $fullyQualifiedName\n" if($debug);
  1108.     my $oldnode = kdocAstUtil::findRef( $cNode, $fullyQualifiedName );
  1109.     my $node = defined $oldnode ? $oldnode : Ast::New( $name );
  1110.  
  1111.     if ( $endTag ne "{" ) {
  1112.         # forward
  1113.         if ( !defined $oldnode ) {
  1114.             # new forward node
  1115.             $node->AddProp( "NodeType", "Forward" );
  1116.             $node->AddProp( "KidAccess", $access );
  1117.             print "newClass: Attaching $node->{astNodeName} to $cNode->{astNodeName}\n" if $debug;
  1118.             kdocAstUtil::attachChild( $cNode, $node );
  1119.         }
  1120.         return $node;
  1121.     }
  1122.  
  1123.     # this is a class declaration
  1124.  
  1125.     print "ClassName: $name\n" if $debug;
  1126.  
  1127.     $node->AddProp( "NodeType", $cNodeType );
  1128.     $node->AddProp( "Compound", 1 );
  1129.     $node->AddProp( "Source", $cSourceNode );
  1130.  
  1131.     if ($cNodeType eq 'namespace') {
  1132.         $node->AddPropList( "Sources", $cSourceNode );
  1133.     }
  1134.  
  1135.     $node->AddProp( "KidAccess", $access );
  1136.     $node->AddProp( "Export", $export ) unless $export eq "";
  1137.     $node->AddProp( "Tmpl", $tmplArgs ) unless $tmplArgs eq "";
  1138.  
  1139.     if ( !defined $oldnode ) {
  1140.         print "newClass: Attaching $node->{astNodeName} to $cNode->{astNodeName}\n" if $debug;
  1141.         kdocAstUtil::attachChild( $cNode, $node );
  1142.     } else {
  1143.         print "newClass: Already found $node->{astNodeName} in $cNode->{astNodeName}\n" if $debug;
  1144.     }
  1145.  
  1146.     # inheritance
  1147.  
  1148.     foreach my $ances ( splice (@_, 5) ) {
  1149.         my $type = "";
  1150.         my $name = $ances;
  1151.         my $intmpl = undef;
  1152.  
  1153. WORD:
  1154.         foreach my $word ( split ( /([\w:]+(:?\s*<.*>)?)/, $ances ) ) {
  1155.             next WORD unless $word =~ /^[\w:]/;
  1156.             if ( $word =~ /(private|public|protected|virtual)/ ) {
  1157.                 $type .= "$1 ";
  1158.             }
  1159.             else {
  1160.                 
  1161.                 if ( $word =~ /<(.*)>/ ) {
  1162.                     # FIXME: Handle multiple tmpl args
  1163.                     $name = $`;
  1164.                     $intmpl = $1;
  1165.                 }
  1166.                 else {
  1167.                     $name = $word;
  1168.                 }
  1169.  
  1170.                 last WORD;
  1171.             }
  1172.         }
  1173.  
  1174.         # set inheritance access specifier if none specified
  1175.         if ( $type eq "" ) {
  1176.             $type = $cNodeType eq "class" ? "private ":"public ";
  1177.         }
  1178.         chop $type;
  1179.  
  1180.         # attach inheritance information
  1181.         my $n = kdocAstUtil::newInherit( $node, $name );
  1182.         $n->AddProp( "Type", $type );
  1183.  
  1184.         $n->AddProp( "TmplType", $intmpl ) if defined $intmpl;
  1185.  
  1186.         print "In: $name type: $type, tmpl: $intmpl\n" if $debug;
  1187.     }
  1188.  
  1189.     # new current node
  1190.     print "newClass: Pushing $cNode->{astNodeName}, new current node is $node->{astNodeName}\n" if $debug;
  1191.     push ( @classStack, $cNode );
  1192.     $cNode = $node;
  1193.  
  1194.     return $node;
  1195. }
  1196.  
  1197.  
  1198. =head3 parseInheritance
  1199.  
  1200.     Param: inheritance decl string
  1201.     Returns: list of superclasses (template decls included)
  1202.  
  1203.     This will fail if < and > appear in strings in the decl.
  1204.  
  1205. =cut
  1206.  
  1207. sub parseInheritance
  1208. {
  1209.     my $instring = shift;
  1210.     my @inherits = ();
  1211.  
  1212.     my $accum = "";
  1213.     foreach $instring ( split (/\s*,\s*/, $instring) ) {
  1214.         $accum .= $instring.", ";
  1215.         next unless  (kdocUtil::countReg( $accum, "<" )
  1216.             - kdocUtil::countReg( $accum, ">" ) ) == 0;
  1217.  
  1218.         # matching no. of < and >, so assume the parent is
  1219.         # complete
  1220.         $accum =~ s/,\s*$//;
  1221.         print "Inherits: '$accum'\n" if $debug;
  1222.         push @inherits, $accum;
  1223.         $accum = "";
  1224.     }
  1225.  
  1226.     return @inherits;
  1227. }
  1228.  
  1229.  
  1230. =head2 newNamespace
  1231.  
  1232.     Param: namespace name.
  1233.     Returns nothing.
  1234.  
  1235.     Imports a namespace into the current node, for ref searches etc.
  1236.     Triggered by "using namespace ..."
  1237.  
  1238. =cut
  1239.  
  1240. sub newNamespace
  1241. {
  1242.     $cNode->AddPropList( "ImpNames", shift );
  1243. }
  1244.  
  1245.  
  1246.  
  1247. =head2 newTypedef
  1248.  
  1249.     Parameters: realtype, name
  1250.  
  1251.     Handles a type definition.
  1252.  
  1253. =cut
  1254.  
  1255. sub newTypedef
  1256. {
  1257.     my ( $realtype, $name ) = @_;
  1258.  
  1259.     my ( $node ) = Ast::New( $name );
  1260.  
  1261.     $node->AddProp( "NodeType", "typedef" );
  1262.     $node->AddProp( "Type", $realtype );
  1263.  
  1264.     kdocAstUtil::attachChild( $cNode, $node );
  1265.  
  1266.     return $node;
  1267. }
  1268.  
  1269. =head2 newTypedefComp
  1270.  
  1271.     Params: realtype, name endtoken
  1272.  
  1273.     Creates a new compound type definition.
  1274.  
  1275. =cut
  1276.  
  1277. sub newTypedefComp
  1278. {
  1279.     my ( $realtype, $name, $endtag ) = @_;
  1280.  
  1281.     my ( $node ) = Ast::New( $name );
  1282.  
  1283.     $node->AddProp( "NodeType", "typedef" );
  1284.     $node->AddProp( "Type", $realtype );
  1285.  
  1286.     kdocAstUtil::attachChild( $cNode, $node );
  1287.  
  1288.     if ( $endtag eq '{' ) {
  1289.         print "newTypedefComp: Pushing $cNode->{astNodeName}\n" 
  1290.             if $debug;
  1291.         push ( @classStack, $cNode );
  1292.         $cNode = $node;
  1293.     }
  1294.  
  1295.     return $node;
  1296. }
  1297.  
  1298.  
  1299. =head2 newMethod
  1300.  
  1301.     Parameters: retType, name, params, const, pure?
  1302.  
  1303.     Handles a new method declaration or definition.
  1304.  
  1305. =cut
  1306. BEGIN {
  1307.  
  1308. my $theSourceNode = $cSourceNode;
  1309.  
  1310. sub newMethod
  1311. {
  1312.     my ( $retType, $name, $params, $const, $pure ) = @_;
  1313.     my $parent = $cNode;
  1314.     my $class;
  1315.  
  1316.     print "Cracked: [$retType] [$name]\n\t[$params]\n\t[$const]\n" 
  1317.         if $debug;
  1318.  
  1319.     if ( $retType =~ /([\w\s_<>,]+)\s*::\s*$/ ) {
  1320.         # check if stuff before :: got into rettype by mistake.
  1321.         $retType = $`;
  1322.         ($name = $1."::".$name);
  1323.         $name =~ s/\s+/ /g;
  1324.         print "New name = \"$name\" and type = '$retType'\n" if $debug;
  1325.     }
  1326.  
  1327.     # A 'friend method' declaration isn't a real method declaration
  1328.     return undef if ( $retType =~ /^friend\s+/ || $retType =~ /^friend\s+class\s+/ );
  1329.  
  1330.     my $isGlobalSpace = 0;
  1331.  
  1332.     if( $name =~ /^\s*(.*?)\s*::\s*(.*?)\s*$/ ) {
  1333.         # Fully qualified method name.
  1334.         $name = $2;
  1335.         $class = $1;
  1336.  
  1337.         if( $class =~ /^\s*$/ ) {
  1338.             $parent = $rootNode;
  1339.         }
  1340.         elsif ( $class eq $cNode->{astNodeName} ) {
  1341.             $parent = $cNode;
  1342.         }
  1343.         else {
  1344.             # ALWAYS IGNORE...
  1345.             return undef;
  1346.             
  1347.             my $node = kdocAstUtil::findRef( $cNode, $class );
  1348.             
  1349.             if ( !defined $node ) {
  1350.                 # if we couldn't find the name, try again with
  1351.                 # all template parameters stripped off:
  1352.                 my $strippedClass = $class;
  1353.                 $strippedClass =~ s/<[^<>]*>//g;
  1354.  
  1355.                 $node = kdocAstUtil::findRef( $cNode, $strippedClass );
  1356.  
  1357.                 # if still not found: give up
  1358.                 if ( !defined $node ) {
  1359.                         warn "$exe: Unidentified class: $class ".
  1360.                                 "in $currentfile\:$.\n";
  1361.                         return undef;
  1362.                 }
  1363.             }
  1364.  
  1365.             $parent = $node;
  1366.         }
  1367.     }
  1368.     # TODO  fix for $retType =~ /template<.*?>/
  1369.     elsif( $parse_global_space && $parent->{NodeType} eq "root" && $name !~ /\s*qt_/ && $retType !~ /template\s*<.*?>/ ) {
  1370.         $class = $globalSpaceClassName; # FIXME - sanitize the naming system?
  1371.         $isGlobalSpace = 1;
  1372.  
  1373.         my $opsNode = kdocAstUtil::findRef( $cNode, $class );
  1374.         if (!$opsNode) {
  1375.         # manually create a "GlobalSpace" class
  1376.         $opsNode = Ast::New( $class );
  1377.         $opsNode->AddProp( "NodeType", "class" );
  1378.         $opsNode->AddProp( "Compound", 1 );
  1379.         $opsNode->AddProp( "Source", $cSourceNode ); # dummy
  1380.         $opsNode->AddProp( "KidAccess", "public" );
  1381.         kdocAstUtil::attachChild( $cNode, $opsNode );
  1382.         }
  1383.         # Add a special 'Source' property for methods in global space
  1384.         $cNode->AddProp( "Source", $theSourceNode );
  1385.         unless( $theSourceNode == $cSourceNode ) {
  1386.             $theSourceNode = $cSourceNode;
  1387.             $opsNode->AddPropList( "Sources", $theSourceNode ); # sources are scattered across Qt
  1388.         }
  1389.         $parent = $opsNode;
  1390.     }
  1391.  
  1392.     # flags
  1393.  
  1394.     my $flags = "";
  1395.  
  1396.     if( $retType =~ /static/ || $isGlobalSpace ) {
  1397.         $flags .= "s";
  1398.         $retType =~ s/static//g;
  1399.     }
  1400.  
  1401.     if( $const && !$isGlobalSpace ) {
  1402.         $flags .= "c";
  1403.     }
  1404.  
  1405.     if( $pure ) {
  1406.         $flags .= "p";
  1407.     }
  1408.  
  1409.     if( $retType =~ /virtual/ ) {
  1410.         $flags .= "v";
  1411.         $retType =~ s/virtual//g;
  1412.     }
  1413.  
  1414.     print "\n" if $flags ne "" && $debug;
  1415.  
  1416.     if ( !defined $parent->{KidAccess} ) {
  1417.         warn "'", $parent->{astNodeName}, "' has no KidAccess ",
  1418.         exists $parent->{Forward} ? "(forward)\n" :"\n";
  1419.     }
  1420.  
  1421.     # NB, these are =~, so make sure they are listed in correct order
  1422.     if ( $parent->{KidAccess} =~ /slot/ ) {
  1423.         $flags .= "l";
  1424.     }
  1425.     elsif ( $parent->{KidAccess} =~ /k_dcop_signals/ ) {
  1426.         $flags .= "z";
  1427.     }
  1428.     elsif ( $parent->{KidAccess} =~ /k_dcop_hidden/ ) {
  1429.         $flags .= "y";
  1430.     }
  1431.     elsif ( $parent->{KidAccess} =~ /k_dcop/ ) {
  1432.         $flags .= "d";
  1433.     }
  1434.     elsif ( $parent->{KidAccess} =~ /signal/ ) {
  1435.         $flags .= "n";
  1436.     }
  1437.  
  1438.     $retType =~ s/QM?_EXPORT[_A-Z]*\s*//;
  1439.     $retType =~ s/inline\s+//;
  1440.     $retType =~ s/extern\s+//;
  1441.     $retType =~ s/^\s*//g;
  1442.     $retType =~ s/\s*$//g;
  1443.     $retType =~ s/^class\s/ /;  # Remove redundant class forward decln's
  1444.     $retType =~ s/<class\s/</;
  1445.  
  1446.     # node
  1447.     
  1448.     my $node = Ast::New( $name );
  1449.     $node->AddProp( "NodeType", "method" );
  1450.     $node->AddProp( "Flags", $flags );
  1451.     $node->AddProp( "ReturnType", $retType );
  1452.     $node->AddProp( "Params", $params ); # The raw string with the whole param list
  1453.     makeParamList( $node, $params, 0 ); # Adds the ParamList property containing the list of param nodes
  1454.  
  1455.     $parent->AddProp( "Pure", 1 ) if $pure;
  1456.  
  1457.     kdocAstUtil::attachChild( $parent, $node );
  1458.     return $node;
  1459. }
  1460.  
  1461. }
  1462.  
  1463. =head2 makeParamList
  1464.  
  1465.     Parameters:
  1466.     * method (or enum) node
  1467.     * string containing the whole param list
  1468.     * 1 for enums
  1469.  
  1470.     Adds a property "ParamList" to the method node.
  1471.     This property contains a list of nodes, one for each parameter.
  1472.  
  1473.     Each parameter node has the following properties:
  1474.     * ArgType the type of the argument, e.g. const QString&
  1475.     * ArgName the name of the argument - optionnal
  1476.     * DefaultValue the default value of the argument - optionnal
  1477.  
  1478.     For enum values, ArgType is unset, ArgName is the name, DefaultValue its value.
  1479.  
  1480.     Author: David Faure <faure@kde.org>
  1481. =cut
  1482.  
  1483. sub makeParamList($$$)
  1484. {
  1485.     my ( $methodNode, $params, $isEnum ) = @_;
  1486.     $params =~ s/\s+/ /g; # normalize multiple spaces/tabs into a single one
  1487.     $params =~ s/\s*([\*\&])\s*/$1 /g; # normalize spaces before and after *, &
  1488.     $params =~ s/\s*(,)([^'\s])\s*/$1 $2/g; # And after ',', but not if inside single quotes
  1489.     $params =~ s/^\s*void\s*$//; # foo(void) ==> foo()
  1490.     $params =~ s/^\s*$//;
  1491.     # Make sure the property always exists, makes iteration over it easier
  1492.     $methodNode->AddProp( "ParamList", [] );
  1493.  
  1494.     my @args = kdocUtil::splitUnnested( ',', $params);
  1495.  
  1496.         my $argId = 0;
  1497.     foreach my $arg ( @args ) {
  1498.         my $argType;
  1499.         my $argName;
  1500.         my $defaultparam;
  1501.         $arg =~ s/\s*([^\s].*[^\s])\s*/$1/; # stripWhiteSpace
  1502.         $arg =~ s/(\w+)\[\]/\* $1/; # Turn [] array into *
  1503.         $arg =~ s/^class //; # Remove any redundant 'class' forward decln's
  1504.  
  1505.         # The RE below reads as: = ( string constant or char or cast to numeric literal
  1506.         # or some word/number, with optional bitwise shifts, OR'ed or +'ed flags, and/or function call ).
  1507.         if ( $arg =~ s/\s*=\s*(("[^\"]*")|\([^)]*\)\s*[\+-]?\s*[0-9]+|(\'.\')|(([-\w:~]*)\s*([<>\|\+-]*\s*[\w._]*\s*)*(\([^(]*\))?))// ) {
  1508.             $defaultparam = $1;
  1509.         }
  1510.  
  1511.         if (defined $defaultparam && $isEnum) {
  1512.             # Remove any casts in enum values, for example this in kfileitem.h:
  1513.             #  'enum { Unknown = (mode_t) - 1 };'
  1514.             $defaultparam =~ s/\([^\)]+\)(.*[0-9].*)/$1/;
  1515.         }
  1516.  
  1517.         # Separate arg type from arg name, if the latter is specified
  1518.         if ( $arg =~ /(.*)\s+([\w_]+)\s*$/ || $arg =~ /(.*)\(\s*\*\s([\w_]+)\)\s*\((.*)\)\s*$/ ) {
  1519.             if ( defined $3 ) { # function pointer
  1520.                 $argType = $1."(*)($3)";
  1521.                 $argName = $2;
  1522.             } else {
  1523.                 $argType = $1;
  1524.                 $argName = $2;
  1525.             }
  1526.         } else { # unnamed arg - or enum value
  1527.             $argType = $arg if (!$isEnum);
  1528.             $argName = $arg if ($isEnum);
  1529.         }
  1530.         $argId++;
  1531.         
  1532.         my $node = Ast::New( $argId ); # let's make the arg index the node "name"
  1533.         $node->AddProp( "NodeType", "param" );
  1534.         $node->AddProp( "ArgType", $argType );
  1535.         $node->AddProp( "ArgName", $argName ) if (defined $argName);
  1536.         $node->AddProp( "DefaultValue", $defaultparam ) if (defined $defaultparam);
  1537.         $methodNode->AddPropList( "ParamList", $node );
  1538.         #print STDERR "ArgType: $argType ArgName: $argName\n" if ($debug);
  1539.     }
  1540. }
  1541.  
  1542. =head2 newAccess
  1543.  
  1544.     Parameters: access
  1545.  
  1546.     Sets the default "Access" specifier for the current class node. If
  1547.     the access is a "slot" type, "_slots" is appended to the access
  1548.     string.
  1549.  
  1550. =cut
  1551.  
  1552. sub newAccess
  1553. {
  1554.     my ( $access ) = @_;
  1555.  
  1556.     return undef unless ($access =~ /^\s*(\w+)\s*(slots|$allowed_k_dcop_accesors_re)?/);
  1557.  
  1558.     print "Access: [$1] [$2]\n" if $debug;
  1559.  
  1560.     $access = $1;
  1561.  
  1562.     if ( defined $2 && $2 ne "" ) {
  1563.         $access .= "_" . $2;
  1564.     }
  1565.  
  1566.     $cNode->AddProp( "KidAccess", $access );
  1567.  
  1568.     return $cNode;
  1569. }
  1570.  
  1571.  
  1572. =head2 newVar
  1573.  
  1574.     Parameters: type, name, value
  1575.  
  1576.     New variable. Value is ignored if undef
  1577.  
  1578. =cut
  1579.  
  1580. sub newVar
  1581. {
  1582.     my ( $type, $name, $val ) = @_;
  1583.  
  1584.     my $node = Ast::New( $name );
  1585.     $node->AddProp( "NodeType", "var" );
  1586.  
  1587.     my $static = 0;
  1588.     if ( $type =~ /static/ ) {
  1589.     #    $type =~ s/static//;
  1590.         $static = 1;
  1591.     }
  1592.  
  1593.     $node->AddProp( "Type", $type );
  1594.     $node->AddProp( "Flags", 's' ) if $static;
  1595.     $node->AddProp( "Value", $val ) if defined $val;
  1596.     kdocAstUtil::attachChild( $cNode, $node );
  1597.  
  1598.     return $node;
  1599. }
  1600.  
  1601.  
  1602.  
  1603. =head2 show_version
  1604.  
  1605.     Display short version information and quit.
  1606.  
  1607. =cut
  1608.  
  1609. sub show_version
  1610. {
  1611.     die "$exe: $Version (c) Sirtaj S. Kang <taj\@kde.org>\n";
  1612. }
  1613.