[prev in list] [next in list] [prev in thread] [next in thread]
List: kde-kdoc
Subject: Re: Reflections
From: "Mike J. Chen" <mchen () arch ! sel ! sony ! com>
Date: 1999-09-21 2:32:32
[Download RAW message or body]
Hi
I have a few changes which I've made to my local version of kdoc which
I'd like to see folded in (so I don't have to do them again with the
next release =)). I think these are all bug fixes, or at least they
are appear to be bugs to me. I'm pretty new to perl, and to kdoc as
well, but the changes I've made seem to work for me.
First, let me describe my environment. I've been using kdoc to generate
HTML for some mixed C and C++ code. Since I have a bunch of C code,
I think I've been running into more bugs with global scoped references
then others. Also, since I'm running kdoc on NT (under cygwin and
active perl), I have some NT specific problems as well.
Here's my change list to the most recent snapshot (v2.0a12):
1) kdocLib.pm - line 129, function writeNode, change so that globals
are referenced via all-globals.html instead of $prefix.html.
Essentially, if $prefix is "", then replace with "all-globals.html".
This fixes bug where references in Class .html files to globals
are broken.
2) kdocHTMLutil.pm - line 111, function makeReferences, changed so that
files for class within class use .. instead of ::
in filename (NT doesn't like filename with ::)
3) kdocHTMLutil.pm - line 123, function HeaderPathToHTML changed
so that if $rootref is "", the reference is added with file
being all-globals.html
4) kdocHTMLutil.pm - line 576, function HeaderPathToHTML changed
so that header filenames are in the form of h_classname_h.html
instead of h#classname_h.html which NT doesn't like
5) kdocCxxHTML.pm - line 421, function writeClassDoc, call of refNameEvery()
needs a second argument of $rootnode
6) fix kdoc, around line 414 for parsing enums:
from:
elsif ( $decl =~ /^\s*enum(\s+[-\w_:]*)?\s*\{(.*)/s ) {
to:
elsif ( $decl =~ /^\s*enum\s+([-\w_:]*)?\s*\{(.*)/s ) {
so that extra space is removed from the front of the name of the enum.
This fixes bug where global enums aren't being referenced correctly
in html class files.
7) in kdoc, around line 507, change stripping of "= value" so that the
remaining decl has no spaces between the type and the ';' (otherwise
the parsing afterwards has problems) with
const nameSearchFlags_t FL_LOCKLEAF = 0x04;
and can only parse
const nameSearchFlags_t FL_LOCKLEAF = 0x04;
8) kdoc - line 571, change so that kdoc can parse
extern "C" {
/* a bunch of global functions */
}
I'm including the files as well for diff purposes.
I hope these are useful to others.
A few changes which I haven't been able to do but which I'd like are:
a) It would be nice if the Index table is improved. Currently, my last
column is always the longest, which makes the table look unbalanced.
b) I think handling of the @li should scope within a @param so that we
can have lists within parameter descriptions. Currently, a @li pops
to top level function scope.
Regards,
Mike
Sirtaj Singh Kang wrote:
>
> Hi,
>
> I finish my contract at AXA in mid-September, after which I will be
> hacking kdoc again (I am using it at work here, so Windows support has
> been added to kdoc but still needs a little work). I want kdoc to be at
> version 2.0 fairly soon, so I wanted to know what you folks think needs to
> be done before that.
>
> In general I mean things that are seriously deficient, not really new
> features. My list includes:
>
> 1. Multiple valriables like "int a,b,c;" still don't work, and it still
> has trouble with arrays.
> 2. The latex and man pahge output still need serious work.
> 3. support files for windows install (ActivePerl is required)
> 4. parameters for methods containing parens are not parsed correctly.
> 5. Namespace support - I think this one is a new feature and so is less
> important.
> 6. Docs
> 7. I thing there is still some trouble with the relative link stuff I will
> have to check it
> 8. shit I forgot about the @ref bug. another whopper.
> 9. Prints "Global::" in front of nested class names
> 10. Should nested/child classes be listed in the class hierarchy and
> indees?
>
> Anything else? Go nuts. This is your last chance. ;)
>
> -Taj.
>
> PS. sorry for typos, using widnows telnet over slow connection. I really
> miss linux right now.
>
> Sirtaj S. Kang taj@kde.org ssk@physics.unimelb.edu.au
> Univ of Melbourne The "gui" in "Penguin" is pronounced "K-D-E"
--
Mike J. Chen
Sony U.S. Research Laboratories - DSL, Phone (408) 955-3041
["kdocHTMLutil.pm" (text/html)]
=head1 kdocHTMLutil - Common HTML routines.
=cut
package kdocHTMLutil;
use kdocAstUtil;
use Carp;
use vars qw( $VERSION @ISA @EXPORT $rcount );
BEGIN {
$VERSION = '$Revision: 1.6 $';
@ISA = qw( Exporter );
@EXPORT = qw( makeReferences refName refNameFull refNameEvery hyper
esc printDoc printTextItem wordRef textRef deref
encodeURL newPgHeader tabRow makeHeader
HeaderPathToHTML );
$rcount = 0;
}
sub newPgHeader
{
my $html = shift;
my ( $heading, $desc, $rest, $toclist ) = @_;
my $bw=0;
my $cspan = defined $main::options{"html-logo"} ? 2 : 1;
print $html <<EOF;
<HTML>
<HEAD>
<TITLE>$heading</TITLE>
<META NAME="Generator" CONTENT="KDOC $main::version">
</HEAD>
<BODY bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000099" alink= "#ffffff">
<TABLE WIDTH="100%" BORDER="$bw">
<TR>
<TD>
<TABLE BORDER="$bw">
<TR><TD valign="top" align="left" cellspacing="10">
<h1>$heading</h1>
</TD>
<TD valign="top" align="right" colspan="1">$desc</TD></TR>
</TABLE>
<HR>
<TABLE BORDER="$bw">
$rest
</TABLE>
</TD>
EOF
# print $html '<TABLE BORDER="',$bw,'"><TR><TD>';
my @klist = keys %$toclist;
print $html '<TD align="right"><TABLE BORDER="',$bw,'">';
# image
print $html '<TD rowspan="', ($#klist)+2,'"><IMG SRC=',
$main::options{"html-logo"},'></TD>'
if defined $main::options{"html-logo"};
# TOC
foreach my $item ( sort @klist ) {
print $html '<TR><TD>',
'<small><A HREF="',$toclist->{$item},'">',
$item, "</small></TD></TR>\n";
}
print $html "</TABLE></TD></TR></TABLE>\n";
}
=head2 makeReferences
Parameters: rootnode
Recursively traverses the Kids of the root node, setting
the "Ref" property for each. This is the HTML reference for
the node.
A "NumRef" property is also set for non-compound members,
which is used for on-page links.
=cut
sub makeReferences
{
my ( $root ) = @_;
my $rootref = $root->{Ref};
$rootref = "" if !defined $rootref;
my $ref;
my $rcount = 0;
foreach $kid ( @{ $root->{Kids} } ) {
next if defined $kid->{Ref};
if( !defined $kid->{astNodeName} ) {
print "makeReferences: Node of no name:\n";
kdocAstUtil::dumpAst( $kid );
}
$rcount++;
$kid->AddProp( 'NumRef', "#ref$rcount" );
if( defined $kid->{Compound} ) {
($ref = $rootref) =~ s/\.html$//;
# mchen (2) - change so that files for classes within classes use ".."
# instead of "::" in filename (NT doesn't like filenames with "::")
# $ref .= "::" if $rootref ne "";
$ref .= ".." if $rootref ne "";
$kid->AddProp( 'Ref',
$ref.$kid->{astNodeName}.".html" );
makeReferences( $kid );
}
else {
# mchen (3) - change so that if rootref is "", the property is added
# with all-globals.html as reference
# $ref .= "::" if $rootref ne "";
if ($rootref eq "") {
$kid->AddProp( 'Ref',
"all-globals.html#".$kid->{astNodeName} );
} else {
$kid->AddProp( 'Ref',
$rootref."#".$kid->{astNodeName} );
}
}
}
}
=head2 refName
Parameters: node, refprop?
Returns a hyperlinked name of the node if a reference exists,
or just returns the name otherwise. Useful for printing node names.
If refprop is specified, it is used as the reference property
instead of 'Ref'.
=cut
sub refName
{
my ( $node ) = @_;
confess "refName called with undef" if !defined $node->{astNodeName};
my $ref = defined $_[1] ? $_[1] : 'Ref';
$ref = $node->{ $ref };
my $out;
if ( !defined $ref ) {
$out = $node->{astNodeName};
} else {
$out = '<A HREF="'.encodeURL($ref).'">'.
esc($node->{astNodeName}).'</A>';
}
$out = "<i>".$out."</i>" if exists $node->{Pure};
return $out;
}
=head2 refNameFull
Parameters: node, rootnode, refprop?
Returns a hyperlinked, fully qualified (ie including parents)
name of the node if a reference exists, or just returns the name
otherwise. Useful for printing node names.
If refprop is specified, it is used as the reference property
instead of 'Ref'.
=cut
sub refNameFull
{
my ( $node, $rootnode, $refprop ) = @_;
# make full name
my $name = $node->{astNodeName};
my $parent = $node->{Parent};
while ( $parent != $rootnode ) {
confess if !defined $parent;
$name = $parent->{astNodeName}."::".$name;
$parent = $parent->{Parent};
}
# figure out ref
my $ref = defined $refprop ? $refprop : 'Ref';
$ref = $node->{ $ref };
my $out;
if ( !defined $ref ) {
$out = esc($name);
} else {
$out = '<A HREF="'.encodeURL($ref).'">'.esc($name).'</A>';
}
$out = "<i>".$out."</i>" if exists $node->{Pure};
return $out;
}
=head2 refNameEvery
Parameters: node
Like refNameFull, but every separate link in the chain is
referenced.
=cut
sub refNameEvery
{
my ( $node, $rootnode ) = @_;
# make full name
my $name = $node->{astNodeName};
my $parent = $node->{Parent};
while ( $parent != $rootnode ) {
$name = refName($parent)."::".$name;
$parent = $parent->{Parent};
}
return $name;
}
=head2 hyper
Parameters: hyperlink, text
Returns an HTML hyperlink. The text is escaped.
=cut
sub hyper
{
confess "hyper: undefed parameter $_[0], $_[1]"
unless defined $_[0] && defined $_[1];
return "<A HREF=\"$_[0]\">".esc($_[1])."</A>";
}
=head2 esc
Escape special HTML characters.
=cut
sub esc
{
my $str = $_[ 0 ];
return "" if !defined $str || $str eq "";
$str =~ s/&/&/g;
$str =~ s/</</g;
$str =~ s/>/>/g;
return $str;
}
=head2 printDoc
Parameters: docnode, *filehandle, rootnode, compound
Print a doc node. If compound is specified and non-zero, various
compound node properties are not printed.
=cut
sub printDoc
{
local ($docNode, *CLASS, $rootnode, $comp ) = @_;
my $node;
my $type;
my $text;
my $lasttype = "none";
$comp = defined $comp? $comp : 0;
$text = $docNode->{Text};
if ( defined $text ) {
print CLASS "<p>";
foreach $node ( @$text ) {
$type = $node->{NodeType};
$name = $node->{astNodeName};
warn "Node '", $name, "' has no type"
if !defined $type;
if( $lasttype eq "ListItem" && $type ne $lasttype ) {
print CLASS "</ul><p>\n";
}
if( $type eq "DocText" ) {
print CLASS "", deref( $name, $rootnode );
}
elsif ( $type eq "Pre" ) {
print CLASS "</p><pre>\n",
esc( $name ), "\n</pre><p>";
}
elsif( $type eq "Ref" ) {
my $ref = $node->{Ref};
if ( defined $ref ) {
print "found reference for $name\n";
print CLASS refName( $ref );
}
else {
print CLASS $name;
}
}
elsif ( $type eq "ParaBreak" ) {
print CLASS "</p><p>";
}
elsif ( $type eq "ListItem" ) {
if ( $lasttype ne "ListItem" ) {
print CLASS "</p><ul>\n";
}
print CLASS "<li>",
deref( $name, $rootnode ), "</li>\n";
}
$lasttype = $type;
}
if( $type eq "ListItem" ) {
print CLASS "</ul><p>\n";
}
print CLASS "</p>";
}
# Params
my @paramlist = ();
kdocAstUtil::findNodes( \@paramlist, $docNode->{Text},
"NodeType", "Param" );
if( $#paramlist >= 0 ) {
my $pnode;
print CLASS "<p><b>Parameters</b>:",
"<TABLE BORDER=\"0\" CELLPADDING=\"5\">\n";
foreach $pnode ( @paramlist ) {
print CLASS "<TR><TD align=\"left\" valign=\"top\"><i>",
esc($pnode->{Name}),
"</i></TD><TD align=\"left\" valign=\"top\">",
deref($pnode->{astNodeName}, $rootnode ),
"</TD></TR>\n";
}
print CLASS "</TABLE></P>\n";
}
# Return
printTextItem( $docNode, CLASS, "Returns" );
# Exceptions
$text = $docNode->{Throws};
if ( defined $text ) {
my $comma = "<p><b>Throws</b>: ";
foreach $tosee ( @$text ) {
print CLASS $comma, esc( $tosee );
$comma = ", ";
}
print CLASS "</p>\n";
}
# See
$text = $docNode->{See};
my $tref = $docNode->{SeeRef};
if ( defined $text ) {
my $comma = "<p><b>See also</b>: ";
foreach $ctr ( 0..$#{$text} ) {
if ( defined $tref->[ $ctr ] ) {
print CLASS $comma, refName( $tref->[ $ctr ] );
}
else {
print CLASS $comma, esc( $text->[ $ctr ] );
}
$comma = ", ";
}
print CLASS "</p>\n";
}
return if $comp;
printTextItem( $docNode, CLASS, "Since" );
printTextItem( $docNode, CLASS, "Version" );
printTextItem( $docNode, CLASS, "Id" );
printTextItem( $docNode, CLASS, "Author" );
}
=head3 printTextItem
Parameters: node, *filehandle, prop, label
If prop is set, it prints the label and the prop value deref()ed.
=cut
sub printTextItem
{
local ( $node, *CLASS, $prop, $label ) = @_;
my $text = $node->{ $prop };
return unless defined $text;
$label = $prop unless defined $label;
print CLASS "<p><b>", $label, "</b>: ",
deref( $text, $rootnode ), "</p>\n";
}
=head3 wordRef
Parameters: word
Prints a hyperlink to the word's reference if found, otherwise
just prints the word. Good for @refs etc.
=cut
sub wordRef
{
my ( $str, $rootnode ) = @_;
confess "rootnode is undef" if !defined $rootnode;
return "" if $str eq "";
my $ref = kdocAstUtil::findRef( $rootnode, $str );
return esc($str) if !defined $ref;
return hyper( $ref->{Ref}, esc($str) );
}
=head2 textRef
Parameters: string
Returns: hyperlinked, escaped text.
Tries to find a reference for EVERY WORD in the string, replacing it
with a hyperlink where possible. All non-hyper text is escaped.
Needless to say, this is quite SLOW.
=cut
sub textRef
{
my ( $str, $rootnode ) = @_;
my $word;
my $out = "";
foreach $word ( split( /([^\w:]+)/, $str ) ) {
if ( $word =~ /^[^\w:]/ ) {
$out .= esc($word);
}
else {
$out .= wordRef( $word, $rootnode );
}
}
return $out;
}
=head2 deref
Parameters: text
returns text
dereferences all @refs in the text and returns it.
=cut
sub deref
{
my ( $str, $rootnode ) = @_;
confess "rootnode is null" if !defined $rootnode;
my $out = "";
my $text;
foreach $text ( split (/(\@ref\s+[\w:#]+)/, $str ) ) {
if ( $text =~ /\@ref\s+([\w:#]+)/ ) {
$out .= wordRef( $1, $rootnode );
}
else {
$out .= esc($text);
}
}
return $out;
}
=head2 encodeURL
Parameters: url
Returns: encoded URL
=cut
sub encodeURL
{
my $url = shift;
$url =~ s/:/%3A/g;
return $url;
}
=head2 tabRow
Returns a table row with each element in the arg list as
one cell.
=cut
sub tabRow
{
return "<TR><TH>$_[0]</TH><TD>$_[1]</TD></TR>\n";
}
=head2 fileToHTML
Writes an HTML version of a file.
=cut
sub makeHeader
{
my ( $out, $filename ) = @_;
open ( SOURCE, "$filename" ) || die "Couldn't read $filename\n";
print $out "<pre>\n";
while ( <SOURCE> ) {
print $out esc( $_ );
}
print $out "</pre>\n";
}
=head2 HeaderPathToHTML
Takes the path to a header file and returns an html file name.
=cut
sub HeaderPathToHTML
{
my ( $path ) = @_;
$path =~ s/_/__/g;
# mchen (4) - changed so that header filenames are in the form of
# h_classname_h.html instead of h#classname_h.html which NT doesn't like
# $path =~ s/\//#/g;
$path =~ s/\//./g;
$path =~ s/\./_/g;
return $path.".html";
}
1;
["kdocCxxHTML.pm" (text/plain)]
package kdocCxxHTML;
use File::Path;
use File::Basename;
use Carp;
use Ast;
use kdocAstUtil;
use kdocHTMLutil;
=head1 kdocCxxHTML
Capabilities required from Ast bit:
1. Create an inheritance tree
2. Referencing ability: convert a fully qualified class or member name
to a node reference.
=cut
BEGIN
{
@clist = ();
@docQueue = ();
$host = `uname -n`; chop $host;
$who = `whoami`; chop $who;
$now = localtime; chop $now;
$gentext = "$who\@$host on $now.";
%toclinks = (
'Index' => 'index.html',
'Annotated List' => 'index-long.html',
'Hierarchy' => 'hier.html',
'Globals' => 'all-globals.html',
'Files' => 'header-list.html'
);
$docBotty =<<EOF
<HR>
<table>
<tr><td><small>Generated by: $gentext</small></td></tr>
</table>
</BODY>
</HTML>
EOF
}
sub writeDoc
{
( $lib, $rootnode, $outputdir, $opt ) = @_;
$debug = $main::debug;
print "Generating HTML documentation. \n" unless $main::quiet;
mkpath( $outputdir ) unless -f $outputdir;
makeReferences( $rootnode );
makeClassList( $rootnode );
writeGlobalDoc( $rootnode );
writeClassList( $rootnode );
writeAnnotatedList( $rootnode );
writeHier( $rootnode );
writeHeaderList();
foreach $node ( @{$rootnode->{Kids}} ) {
next if !defined $node->{Compound}
|| defined $node->{ExtSource}
|| $node->{NodeType} eq "Forward";
push @docQueue, $node;
}
while( $#docQueue >= 0 ) {
$node = pop @docQueue;
writeClassDoc( $node );
}
}
=head2 writeAnnotatedList
Parameters: rootnode
Writes out a list of classes with short descriptions to
index-long.html.
=cut
sub writeAnnotatedList
{
my ( $root ) = @_;
my $short;
open(CLIST, ">$outputdir/index-long.html")
|| die "Couldn't create $outputdir/index-long.html\n";
newPgHeader( *CLIST{IO}, "$lib Annotated List", "", "", \%toclinks );
print CLIST '<TABLE WIDTH="100%" BORDER=\"0\">';
my $colnum = 0;
my $colour;
foreach $node ( @clist ) {
print "undef in clist\n" if !defined $node;
$docnode = $node->{DocNode};
$short = "";
if( defined $docnode && exists $docnode->{ClassShort} ) {
$short = deref($docnode->{ClassShort}, $rootnode );
if( !defined $short ) {
print $root->{astNodeName}, "has undef short\n";
next;
}
}
$col = $col ? 0 : 1;
$colour = $col ? "" : 'bgcolor="#eeeeee"';
print CLIST "<TR $colour><TD>", refName( $node ),
"</TD><TD>", $short, "</TD></TR>";
}
print CLIST "</TABLE>", $docBotty;
close CLIST;
}
=head2 writeClassList
Parameters: rootnode
Writes out a concise list of classes to index.html
=cut
sub writeClassList
{
my ( $root ) = @_;
open(CLIST, ">$outputdir/index.html")
|| die "Couldn't create $outputdir/index.html\n";
newPgHeader( *CLIST{IO}, "$lib Class Index", "", "", \%toclinks );
print CLIST '<TABLE WIDTH="100%" BORDER="0">';
my $cols = exists $opt->{"html-cols"} ? $opt->{"html-cols"} : 3;
my ( $ctr, $size ) = ( 0, int(($#clist+1)/$cols) );
$size = 1 if $size < 1;
my $s;
print CLIST "<TR>";
while ( $ctr <= $#clist ) {
print CLIST "<TD>";
$s = $ctr+$size-1;
if ( $s > $#clist ) {
$s = $#clist;
}
elsif ( ($#clist - $s) < $cols) {
$s = $#clist;
}
print "Writing from $ctr to $s\n" if $debug;
writeListPart( \@clist, $ctr, $s );
print CLIST "</TD>";
$ctr = $s+1;
}
print CLIST<<EOF;
</TR>
</TABLE>
$docBotty
EOF
close CLIST;
}
=head3
Parameters: list, start index, end index
Helper for writeClassList. Prints a table containing a
hyperlinked list of all nodes in the list from start index to
end index. A table header is also printed.
=cut
sub writeListPart
{
my( $list, $start, $stop ) = @_;
print CLIST "<TABLE BORDER=\"0\">";
print CLIST '<TR bgcolor="b0b0b0"><TH>',
esc( $list->[ $start ]->{astNodeName} ),
" - ", esc( $list->[ $stop ]->{astNodeName} ),
"</TH></TR>";
my $col = 0;
my $colour = "";
for $ctr ( $start..$stop ) {
$col = $col ? 0 : 1;
$colour = $col ? "" : 'bgcolor="#eeeeee"';
print CLIST "<TR $colour><TD>", refName( $list->[ $ctr ] ),
"</TD></TR>\n";
}
print CLIST "</TABLE>";
}
=head2 writeAllMembers
Parameters: node
Writes a list of all methods to "full-list-<class file>"
=cut
sub writeAllMembers
{
my( $node ) = @_;
my $file = "$outputdir/full-list-".$node->{Ref};
my %allmem = ();
kdocAstUtil::allMembers( \%allmem, $node );
open( ALLMEM, ">$file" ) || die "Couldn't create $file\n";
# print ALLMEM pageHeader( \%toclinks, esc($node->{astNodeName})
# ." - All Methods" ), "<UL>";
newPgHeader( *ALLMEM{IO},
$node->{NodeType}." ".esc($node->{astNodeName}).
": All methods", "", "", \%toclinks );
my $mem;
my $col = 0;
my $colour = "";
print ALLMEM '<TABLE>';
foreach $mem ( sort keys %allmem ) {
$col = $col ? 0 : 1;
$colour = $col ? "" : 'bgcolor="#eeeeee"';
print ALLMEM "<TR $colour><TD>", refName( $allmem{ $mem } ),
"</TR></TD>\n";
}
print ALLMEM "</TABLE>$docBotty";
close ALLMEM;
}
=head2 writeHier
Parameters: rootnode
Writes out the class hierarchy index to hier.html.
=cut
sub writeHier
{
my ( $root ) = @_;
open( HIER, ">$outputdir/hier.html")
|| die "Couldn't create $outputdir/hier.html\n";
# print HIER pageHeader( \%toclinks, $lib." Class Hierarchy" );
newPgHeader( *HIER{IO}, "$lib Class Hierarchy", "", "", \%toclinks );
printNodeHier( $root );
print HIER $docBotty;
close HIER;
}
=head3 printNodeHier
Parameters: node
Lists all classes that inherit from this node in an unordered list.
=cut
sub printNodeHier
{
my( $node ) = @_;
my $kid;
my $src = "";
# non-derived external classes are not printed.
if ( defined $node->{ExtSource} ) {
return if !defined $node->{InBy}
|| !kdocAstUtil::hasLocalInheritor( $node );
$src = "<small>(".$node->{ExtSource}.")</small>";
}
print HIER "<LI>", refName( $node )," $src</LI>\n"
unless $node == $rootnode;
return if !defined $node->{InBy};
print HIER "<UL>\n";
foreach $kid ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
@{ $node->{InBy} } ) {
next if defined $kid->{hlisted};
printNodeHier( $kid );
$kid->AddProp( 'hlisted', 1 );
}
print HIER "</UL>\n";
}
=head2 writeHeaderList
Generates the header-list.html file, which contains links
to each processed header. The ARGV list is used.
=cut
sub writeHeaderList
{
open(HDRIDX, ">$outputdir/header-list.html")
|| die "Couldn't create $outputdir/header-list.html\n";
newPgHeader( *HDRIDX{IO}, "$lib File Index", "", "", \%toclinks );
foreach $header ( sort @main::ARGV ) {
$_ = $header;
my $htmlheader = $main_striphpath ? basename ( $_ ) : $_;
my $htmlname = HeaderPathToHTML( $htmlheader );
# convert dashes to double dash, convert path to dash
print HDRIDX "\t<LI>",hyper($htmlname,$htmlheader),"</LI>\n";
writeSrcHTML( "$outputdir/$htmlname", $header );
}
print HDRIDX "</UL>\n",$docBotty;
}
=head2 writeClassDoc
Write documentation for one compound node.
=cut
sub writeClassDoc
{
my( $node ) = @_;
if( exists $node->{ExtSource} ) {
warn "Trying to write doc for ".$node->{AstNodeName}.
" from ".$node->{ExtSource}."\n";
return;
}
my $file = "$outputdir/".$node->{Ref};
my $docnode = $node->{DocNode};
my $hasdoc = exists $node->{DocNode} ? 1 : 0;
my @list = ();
my $version = undef;
my $author = undef;
open( CLASS, ">$file" ) || die "Couldn't create $file\n";
# Header
my $source = kdocAstUtil::nodeSource( $node );
my $short = "";
my $extra = "";
if( $hasdoc ) {
if ( exists $docnode->{ClassShort} ) {
$short .= deref($docnode->{ClassShort},
$rootnode).
" <small>".
hyper( "#longdesc", "More..." )."</small>";
}
if ( exists $docnode->{Deprecated} ) {
$extra .= '<TR><TH colspan="2">'.
'Deprecated! use with care</TH></TR>';
}
if ( exists $docnode->{Internal} ) {
$extra .= '<TR><TH colspan="2">'.
'Internal Use Only</TH></TR>';
}
$version = esc($docnode->{Version})
if exists $docnode->{Version};
$author = esc($docnode->{Author})
if exists $docnode->{Author};
}
# pure virtual check
if ( exists $node->{Pure} ) {
$extra .= '<TR><TH>Contains pure virtuals</TH></TR>';
}
# full name, if not in global scope
if ( $node->{Parent} != $rootnode ) {
$extra .= tabRow( "Full name",
# mchen (5) - changed refNameEvery() call to have second argument of $rootnode
# "<code>".refNameEvery( $node )."</code>" );
"<code>".refNameEvery( $node, $rootnode )."</code>" );
}
# include
$extra .= tabRow( "Definition", "<code>#include <".
hyper( HeaderPathToHTML( $source ), $source )
."></code>" );
# template form
if ( exists $node->{Tmpl} ) {
$extra .= tabRow( "Template form",
esc($node->{astNodeName})
."<".textRef($node->{Tmpl}, $rootnode )."> "
."</code>" );
}
# ancestors
if ( $node != $rootnode && exists $node->{InList} ) {
my $comma = "";
my $out = "";
foreach my $in ( @{ $node->{InList} } ) {
my $nref = $in->{Node};
if( !defined $nref ) {
# not found
$out .= $comma.esc($in->{astNodeName});
}
elsif ( $nref == $rootnode ) {
# global
next;
}
else {
# resolved
$out .= $comma.refName( $nref );
# template type?
if ( exists $in->{TmplType} ) {
$out .= "<".wordRef($in->{TmplType},
$rootnode ).">";
}
if ( exists $nref->{ExtSource} ) {
$out .=" <small>(".$nref->{ExtSource}
.")</small>";
}
$out .= " [ ".$in->{Type}." ]"
unless $in->{Type} eq "public";
$comma = ", ";
}
}
$extra .= tabRow( "Inherits", $out ) unless $out eq "";
}
# descendants
if ( $node != $rootnode && exists $node->{InBy} ) {
my $comma = "";
my $out = "";
@list = ();
kdocAstUtil::inheritedBy( \@list, $node );
foreach $in ( @list ) {
$out .= $comma.refName( $in );
# external source?
if ( exists $in->{ExtSource} ) {
$short .= " <small>(".
$in->{ExtSource}.")</small>";
}
$comma = ", ";
}
$extra .= tabRow( "Inherited by", $out );
}
$extra .= '<TR><TH>'.
hyper( encodeURL("full-list-".$node->{Ref}),
"List of all Methods" )."</TH></TR>";
# print it
newPgHeader( *CLASS{IO},
$node->{NodeType}." ".esc($node->{astNodeName}),
$short, $extra, \%toclinks );
if( $#{$node->{Kids}} < 0 ) {
print CLASS "<center><H4>No members</H4></center>\n";
}
else {
listMethods( $node, "Public Members", "public" );
listMethods( $node, "Public Slots", "public_slots" );
listMethods( $node, "Protected Members", "protected" );
listMethods( $node, "Protected Slots", "protected_slots" );
listMethods( $node, "Signals", "signals" );
if ( $main::doPrivate ) {
listMethods( $node, "Private Members", "private" );
listMethods( $node, "Private Slots", "private_slots" );
}
}
# long description
if ( $hasdoc ) {
print CLASS "<HR><A NAME=\"longdesc\">",
"<H2>Detailed Description</H2>";
printDoc( $docnode, *CLASS, $rootnode, 1 );
}
# member doc
my $kid;
my ($numref, $ref);
foreach $kid ( @{$node->{Kids}} ) {
next if defined $kid->{ExtSource}
|| $node->{NodeType} eq "Forward"
|| (!$main::doPrivate &&
$kid->{Access} =~ /private/);
if ( exists $kid->{Compound} ) {
push @docQueue, $kid;
}
next if !defined $kid->{DocNode};
if( !exists $kid->{NumRef} ) {
warn $kid->{astNodeName}, " type ",
$kid->{NodeType}, " doesn't have a numref\n";
}
( $numref = $kid->{NumRef} ) =~ s/^.*?#//g;
( $ref = $kid->{Ref} ) =~ s/^.*?#//g;
printMemberName( $kid, $ref, $numref );
printDoc( $kid->{DocNode}, *CLASS, $rootnode );
if ( $kid->{NodeType} eq "method" ) {
$ref = kdocAstUtil::findOverride( $rootnode, $node,
$kid->{astNodeName} );
if ( defined $ref ) {
print CLASS "<p>Reimplemented from ",
refName( $ref ), "</p>\n";
}
}
}
# done
if ( defined $version || defined $author ) {
print CLASS "<HR><UL>",
defined $version ?
"<LI><i>Version</i>: $version</LI>" : "",
defined $author ?
"<LI><i>Author</i>: $author</LI>" : "",
"<LI><i>Generated</i>: $gentext</LI></UL>",
"</BODY></HTML>\n";
}
else {
print CLASS $docBotty;
}
close CLASS;
# full member list
writeAllMembers( $node );
}
sub writeGlobalDoc
{
my( $node ) = @_;
my $file = "$outputdir/all-globals.html";
my $docnode = $node->{DocNode};
my $hasdoc = exists $node->{DocNode} ? 1 : 0;
my @list = ();
my $cumu = Ast::New( "nodelist" );
my $kid;
# make a list of nodes by file
foreach $kid ( @{$node->{Kids}} ) {
next if exists $kid->{ExtSource}
|| exists $kid->{Compound}
|| (!$main::doPrivate &&
$kid->{Access} =~ /private/);
$cumu->AddPropList( kdocAstUtil::nodeSource( $kid ), $kid )
unless !exists $kid->{Source};
}
open( CLASS, ">$file" ) || die "Couldn't create $file\n";
# print CLASS pageHeader( \%toclinks, "Globals" );
newPgHeader( *CLASS{IO}, $lib." Globals", "", "", \%toclinks );
@list = sort keys %$cumu;
foreach $file ( @list ) {
next if $file eq "astNodeName";
listMethods( $node, $file, "", $cumu->{$file} );
}
# member doc
my ($numref, $ref);
foreach $file ( @list ) {
next if $file eq "astNodeName";
foreach $kid ( @{$cumu->{$file}} ) {
next if exists $kid->{ExtSource}
|| exists $kid->{Compound}
|| !exists $kid->{DocNode}
|| (!$main::doPrivate &&
$kid->{Access} =~ /private/);
if( !exists $kid->{NumRef} ) {
warn $kid->{astNodeName}, " type ",
$kid->{NodeType}, " doesn't have a numref\n";
}
( $numref = $kid->{NumRef} ) =~ s/^.*?#//g;
( $ref = $kid->{Ref} ) =~ s/^.*?#//g;
printMemberName( $kid, $ref, $numref );
print CLASS "<p><small><code>#include <",
kdocAstUtil::nodeSource( $kid ),
"></code></small></p>";
printDoc( $kid->{DocNode}, *CLASS, $rootnode );
}
}
print CLASS $docBotty;
close CLASS;
}
sub listMethods
{
my( $class, $desc, $vis, $nodes ) = @_;
my $name;
my $type;
my $flags;
my @n=();
if ( !defined $nodes ) {
kdocAstUtil::findNodes( \@n, $class->{Kids},
"Access", $vis );
$nodes = \@n;
}
return if ( $#{$nodes} < 0 );
print CLASS<<EOF;
<H2>$desc</H2>
<UL>
EOF
foreach $m ( @$nodes ) {
next if exists $m->{ExtSource};
if( exists $m->{Compound} ) {
# compound docs not printed for rootnode
next if $class eq $rootnode;
$name = refName( $m );
}
elsif( exists $m->{DocNode} ) {
# compound nodes have their own page
$name = refName( $m, 'NumRef' );
} else {
$name = esc( $m->{astNodeName} );
}
$type = $m->{NodeType};
print CLASS "<LI>";
if( $type eq "var" ) {
print CLASS esc( $m->{Type}),
" <b>", $name,"</b>\n";
}
elsif( $type eq "method" ) {
$flags = $m->{Flags};
if ( !defined $flags ) {
warn "Method ".$m->{astNodeName}.
" has no flags\n";
}
$name = "<i>$name</i>" if $flags =~ /p/;
my $extra = "";
$extra .= "virtual " if $flags =~ "v";
$extra .= "static " if $flags =~ "s";
print CLASS $extra, esc($m->{ReturnType}),
" <b>", $name, "</b> (",
esc($m->{Params}), ") ",
$flags =~ /c/ ? " const\n": "\n";
}
elsif( $type eq "enum" ) {
print CLASS "enum <b>", $name, "</b> {",
esc($m->{Params}),"}\n";
}
elsif( $type eq "typedef" ) {
print CLASS "typedef ",
esc($m->{Type}), " <b>",
$name,"</b>";
}
else {
# unknown type
print CLASS esc($type), " <b>",
$name,"</b>\n";
}
print CLASS "</LI>\n";
}
print CLASS<<EOF;
</UL>
EOF
}
=head2 printIndexEntry
Parameters: member node
Prints an index entry for a single node.
TODO: stub
=cut
sub printIndexEntry
{
my ( @node ) = @_;
}
=head2 printMemberName
Parameters: member node, names...
Prints the name of one member, customized to type. If names are
specified, a name anchor is written for each one.
=cut
sub printMemberName
{
my $m = shift;
my $name = esc( $m->{astNodeName} );
my $type = $m->{NodeType};
my $ref;
my $flags = undef;
foreach $ref ( @_ ) {
print CLASS "<A NAME=", $ref, "></A>";
}
print CLASS '<table width="100%"><tr bgcolor="#eeeeee"><td><strong>';
if( $type eq "var" ) {
print CLASS textRef($m->{Type}, $rootnode ),
" <b>", $name,"</b>\n";
}
elsif( $type eq "method" ) {
$flags = $m->{Flags};
$name = "<i>$name</i>" if $flags =~ /p/;
print CLASS textRef($m->{ReturnType}, $rootnode ),
" <b>", $name, "</b> (",
textRef($m->{Params}, $rootnode ), ")\n";
}
elsif( $type eq "enum" ) {
print CLASS "enum <b>", $name, "</b> {",
esc($m->{Params}),"}\n";
}
elsif( $type eq "typedef" ) {
print CLASS "typedef ",
textRef($m->{Type}, $rootnode ), " <b>", $name,"</b>";
}
else {
print CLASS $name, " <small>(", esc($type), ")</small>";
}
print CLASS "</strong></td></tr></table>";
# extra attributes
my @extra = ();
if( !exists $m->{Access} ) {
print "Member without access:\n";
kdocAstUtil::dumpAst( $m );
}
($ref = $m->{Access}) =~ s/_slots//g;
push @extra, $ref
unless $ref =~ /public/
|| $ref =~ /signal/;
if ( defined $flags ) {
my $f;
my $n;
foreach $f ( split( "", $flags ) ) {
$n = $main::flagnames{ $f };
warn "flag $f has no long name.\n" if !defined $n;
push @extra, $n;
}
}
if ( $#extra >= 0 ) {
print CLASS " <small>[", join( " ", @extra ), "]</small>";
}
print CLASS "</p>";
# finis
}
=head2 makeClassList
Parameters: node
fills global @clist with a list of all direct, non-external
compound children of node.
=cut
sub makeClassList
{
my ( $rootnode ) = @_;
@clist = ();
foreach $node ( @ {$rootnode->{Kids}} ) {
if ( !defined $node ) {
print "makeClassList: undefined child in rootnode!\n";
next;
}
push( @clist, $node ) unless exists $node->{ExtSource}
|| !exists $node->{Compound};
}
@clist = sort { $a->{astNodeName} cmp $b->{astNodeName} }
@clist;
}
sub writeSrcHTML
{
my ( $outfile, $infile ) = @_;
open ( OUT, ">$outfile" ) || die "Couldn't open $outfile for".
"writing.\n";
newPgHeader( *OUT{IO}, "Source: $infile", "", "", \%toclinks );
makeHeader( *OUT{IO}, $infile );
print OUT $docBotty;
close OUT;
}
1;
["kdoc" (text/plain)]
#!/usr/local/bin/perl -w
# KDOC -- C++ and CORBA IDL interface documentation tool.
# Sirtaj Singh Kang <taj@kde.org>, Jan 1999.
# $Id: kdoc,v 1.16 1999/07/16 00:57:52 ssk 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 Ast;
use kdocUtil;
use kdocAstUtil;
use kdocParseDoc;
# globals
%rootNodes = (); # root nodes for each file type
$declNodeType = undef; # last declaration type
# All options
%options = (); # hash of options (set getopt below)
$libdir = $ENV{KDOCLIBS};
$libname = "";
$outputdir = ".";
@libs = (); # list of includes
$striphpath = 0;
$doPrivate = 0;
$Version = "$Version\$";
$quiet = 0;
$debug = 0;
$parseonly = 0;
$currentfile = "";
$exe = basename $0;
# these are for expansion of method flags
%flagnames = ( v => 'virtual', 's' => 'static', p => 'pure',
c => 'const', l => 'slot', i => 'inline', n => 'signal' );
=head1 KDOC -- Source documentation tool
Sirtaj Singh Kang <taj@kde.org>, Dec 1998.
=cut
# read options
Getopt::Long::config qw( no_ignore_case permute bundling auto_abbrev );
$err = GetOptions( \%options, "html|H",
"latex|T", "man|M",
"texinfo|X",
"url|u=s",
"skip-internal|i",
"skip-deprecated|e",
"document-all|a",
"compress|z",
# HTML options
"html-cols=i",
"html-logo=s",
"strip-h-path", \$striphpath,
"outputdir|d=s", \$outputdir,
"name|n=s", \$libname,
"help|h", \&show_usage,
"version|v|V", \&show_version,
"private|p", \$doPrivate,
"libdir|L=s", \$libdir,
"xref|l=s", \@libs,
"quiet|q", \$quiet,
"debug|D", \$debug,
"parse-only", \$parseonly );
if ( $err == 0 ) {
exit 1;
}
# work out libdir. This is created by kdocLib:writeDoc when
# required.
$libdir = $ENV{HOME}."/.kdoc" unless defined $libdir;
# HTML is the default
if( !exists $options{html} && !exists $options{latex}
&& !exists $options{man} && !exists $options{texinfo} ) {
$options{html} = 1;
}
# read all libraries
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;
print "url: $options{url} outputdir: $outputdir, chose ",
"$relpath\n";
kdocLib::readLibrary( \&getRoot, $lib, $libdir,
$relpath );
}
}
# process files
die "$exe: no input files.\n" if $#ARGV < 0;
foreach $currentfile ( @ARGV ) {
open( INPUT, "$currentfile" ) || croak "Can't read from $currentfile";
print "$exe: processing $currentfile\n" unless $quiet;
# reset vars
if ( $currentfile =~ /\.idl\s*$/ ) {
# IDL file
$rootNode = getRoot( "IDL" );
}
else {
# assume cxx file
$rootNode = getRoot( "CXX" );
}
$classStack = ();
$cNode = $rootNode;
# parse
do {
$k = readDecl();
if( defined $k ) {
print "\nDecl: <$k>\n" if $debug;
if( identifyDecl( $k ) && $k =~ /{/ ) {
readCxxCodeBlock();
}
}
} while( defined $k );
close INPUT;
}
#kdocAstUtil::testRef( $rootNode );
if ( !$parseonly ) {
foreach my $name ( keys %rootNodes ) {
my $node = $rootNodes{ $name };
kdocAstUtil::makeInherit( $node, $node );
kdocAstUtil::linkReferences( $node, $node );
if ( $name eq "CXX" ) {
if ( exists $options{texinfo} ) {
require kdoctexi;
kdoctexi::writeDoc( $libname,
$node, $outputdir, \%options );
}
if ( exists $options{html} ) {
require kdocCxxHTML;
kdocCxxHTML::writeDoc( $libname, $node,
$outputdir, \%options );
}
}
elsif( $name eq "IDL" ) {
if ( exists $options{texinfo} ) {
warn "$exe: sorry, texinfo is not yet ".
"supported for IDL\n";
}
if ( exists $options{html} ) {
require kdocIDLhtml;
kdocIDLhtml::writeDoc( $libname, $node,
$outputdir, \%options );
}
}
}
# write libraries
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 );
}
}
}
else {
print "\n\tParse Tree\n\t------------\n\n";
kdocAstUtil::dumpAst( $rootNode );
}
kdocAstUtil::printDebugStats() if $debug;
#
# main ends
########################################################
=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 ) {
return undef if !defined ($p = <INPUT>);
$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;
}
}
next if ( $p =~ /^\s*$/s # blank lines
|| $p =~ /^\s*Q_OBJECT/ # QObject macro
);
# remove all preprocessor macros except #include
next if( $p =~ /^\s*#\s*(\w+)/ );
# {
# next if $1 ne "include";
# }
$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;
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;
$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;
$add = kdocUtil::countReg( $l, "{" );
$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 $lastNodeType variable.
A decl starts with a type or keyword and ends with a ; or {
The entire decl is returned in a single line, sans newlines.
lastNodeType 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 );
}
=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 );
}
elsif ( $declNodeType eq "a" ) {
newAccess( $decl );
}
elsif ( $decl =~ /^\s*typedef\s+(struct|union|class|enum)\s*/ ) {
warn "typedef '$1' at $currentfile:$.\n";
$skipBlock = 1;
}
# Typedef
elsif ( $decl =~ /^\s*typedef\s+
(.*?\s*[\*&]?) # type
\s*([-\w_\:]+) # name
\s*[{;]\s*$/xs ) {
print "Typedef: <$1> <$2>\n" if $debug;
$newNode = newTypedef( $1, $2 );
}
# Enum
# mchen (6) - changed to remove extra space from front of enum name
# elsif ( $decl =~ /^\s*enum(\s+[-\w_:]*)?\s*\{(.*)/s ) {
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*<(.*)>)? # template
\s*(class|struct|union) # struct type
\s+([-\w_]+) # name
(.*?) # inheritance?
[;{]/xs ) {
print "Class: [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n" if $debug;
my ( $tfull, $targs, $ntype, $name, $rest ) =
( $1, $2, $3, $4, $5 );
my @inherits = ();
if( $rest =~ /^\s*:\s*/ ) {
$rest = $';
@inherits = split /\s*,\s*/, $rest;
if ( $debug ) {
foreach $rest ( @inherits ) {
print "Inherits: $rest\n"
}
}
}
$newNode = newClass( $decl, $tfull, $targs, $ntype,
$name, @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*(.+?) # return type + name
\( (.*?) \) # parameters
(.*?)[;{]+/xs ) { # rest
print "Method: [$1]\n\t[$2]\n\t[$3]\n" if $debug;
my $tpn = $1; # type + name
my $params = $2;
my $rest = $3;
my $const = 0;
if( $rest =~ /const/ ) {
$const = 1;
}
my $pure = 0;
if ( $rest =~ /=\s*0/ ) {
$pure = 1;
}
if ( $tpn =~ /((:?\S+::)?operator.*?)\s*$/ # operator
|| $tpn =~ /(~?[-\w:]+)\s*$/ ) { # normal
$name = $1;
$tpn = $`;
$newNode = newMethod( $tpn, $name,
$params, $const, $pure );
}
$skipBlock = 1;
}
# Variable
elsif ( $decl =~ /^\s*(?:[\w_:<>]\s*)+ # type
[\&\s\*]* # ptr or ref
[\w_\[\]\s]+ # name
(?:\=.*)? # value
\s*[;{]/xs ) {
# TODO FIXME: Assuming everything is a variable.
my $val = undef;
if ( $decl =~ /=(.*?)\s*[;{]/ ) {
# store and remove value
$val = $1;
# mchen (7) - changed stripping of "= value" so that the remaining
# decl has no spaces between the type and the ending ";" (otherwise
# the parsing afterwards has problems with
#
# const nameSearchFlags_t FL_LOCKLEAF = 0x04;
#
# and can only parse
#
# const nameSearchFlags_t FL_LOCKLEAF = 0x4;
#
# $decl =~ s/=.*([;{])/$1/;
$decl =~ s/\s*=.*([;{])/$1/;
}
if( $decl =~ /^(.*)([\s&\*]+)\s* # type
([\w:_\s]+) # name
\s*((?:\[.*\])?) # array
\s*([;{])\s*$/xs ) { # end
my $var = $3;
my $rest = $1.$2.$4;
$rest =~ s/\s+$//g;
print "Var: [$var] type: [$rest] val: [$val]\n"
if $debug;
$newNode = newVar( $rest, $var, $val );
$skipBlock = 1 if $decl =~ /{\s*$/;
}
else {
carp "Type match: failed with $decl\n";
}
}
# end of an in-block declaration
elsif ( $decl =~ /}\s*(.*?);/ ) {
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 =~ /{/ ) {
# mchen (8) - change so that parsing of extern "C" {} blocks works
if ( $decl =~ /extern/ ) {
print "extern \"C\" block\n";
} else {
print "Unidentified block start: $decl\n" if $debug;
$skipBlock = 1;
}
}
else {
## decl is unidentified.
warn "Unidentified decl: $decl\n";
}
# once we get here, the last doc node is already used.
if( defined $newNode ) {
$newNode->AddProp( "Source", $currentfile )
unless $newNode->{NodeType} eq "Forward";
if ( defined $docNode ) {
$newNode->AddProp( "DocNode", $docNode );
$newNode->AddProp( "Internal", 1 )
if defined $docNode->{Internal};
$newNode->AddProp( "Deprecated", 1 )
if defined $docNode->{Deprecated};
undef $docNode;
}
}
return $skipBlock;
}
=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;
}
=head3 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 );
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 );
}
# 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: decl, tmplFull, tmplArgs, cNodeType, name, @inheritlist
Handles a class declaration (also fwd decls).
=cut
sub newClass
{
my( $decl, $tmplFull, $tmplArgs,
$cNodeType, $name ) = @_;
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 = undef;
my $node = defined $oldnode ? $oldnode : Ast::New( $name );
unless ( $decl =~ /{/ ) {
# 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( "KidAccess", $access );
$node->AddProp( "Tmpl", $tmplArgs ) unless !defined $tmplArgs;
if ( !defined $oldnode ) {
kdocAstUtil::attachChild( $cNode, $node );
}
# inheritance
foreach my $ances ( splice (@_, 5) ) {
my $type = "";
my $name = $ances;
my $intmpl = undef;
WORD:
foreach my $word ( split ( /([\w:]+(:?\s*<.*>)?)/, $ances ) ) {
next WORD unless $word =~ /^[\w:]/;
if ( $word =~ /(private|public|protected|virtual)/ ) {
$type .= "$1 ";
}
else {
if ( $word =~ /<(.*)>/ ) {
# FIXME: Handle multiple tmpl args
$name = $`;
$intmpl = $1;
}
else {
$name = $word;
}
last WORD;
}
}
chop $type unless $type eq "";
my $n = kdocAstUtil::newInherit( $node, $name );
$n->AddProp( "Type", $type );
$n->AddProp( "TmplType", $intmpl ) if defined $intmpl;
}
# new current node
print "newClass: Pushing $cNode->{astNodeName}\n" if $debug;
push ( @classStack, $cNode );
$cNode = $node;
return $node;
}
=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 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( $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 {
my $node = kdocAstUtil::findRef( $cNode, $class );
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";
}
# node
my $node = Ast::New( $name );
$node->AddProp( "NodeType", "method" );
$node->AddProp( "Flags", $flags );
$node->AddProp( "ReturnType", $retType );
$node->AddProp( "Params", $params );
$parent->AddProp( "Pure", 1 ) if $pure;
kdocAstUtil::attachChild( $parent, $node );
return $node;
}
=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( "Static", $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] [-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 "kdoc: $Version (c) Sirtaj S. Kang <taj\@kde.org>\n";
}
=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 };
}
["kdocLib.pm" (text/plain)]
=head1 kdocLib
Writes out a library file.
NOTES ON THE NEW FORMAT
Stores: class name, members, hierarchy
node types are not stored
File Format Spec
----------------
header
zero or more members, each of
method
member
class, each of
inheritance
zero or more members
Unrecognized lines ignored.
Sample
------
<! KDOC Library HTML Reference File>
<VERSION="2.0">
<BASE URL="http://www.kde.org/API/kdecore/">
<C NAME="KApplication" REF="KApplication.html">
<IN NAME="QObject">
<ME NAME="getConfig" REF="KApplication.html#getConfig">
<M NAME="" REF="">
</C>
=cut
package kdocLib;
use Carp;
use File::Path;
use File::Basename;
use Ast;
use kdocAstUtil;
use kdocUtil;
BEGIN {
$exe = basename $0;
}
sub writeDoc
{
( $lib, $root, $plang, $outputdir, $docpath, $url,
$compress ) = @_;
$outfile = "$outputdir/$lib.kdoc";
$url = $docpath unless defined $url;
mkpath( $outputdir ) unless -f $outputdir;
if( $compress ) {
open( LIB, "| gzip -9 > \"$outfile.gz\"" )
|| die "$exe: couldn't write to $outfile.gz\n";
}
else {
open( LIB, ">$outfile" )
|| die "$exe: couldn't write to $outfile\n";
}
print LIB<<LTEXT;
<! KDOC Library HTML Reference File>
<VERSION="$main::Version">
<BASE URL="$url">
LTEXT
print LIB "<PLANG=\"$plang\">\n";
writeNode( $root, "" );
close LIB;
}
sub writeNode
{
my ( $n, $prefix ) = @_;
return if !exists $n->{Compound};
return if exists $n->{Forward} && !exists $n->{KidAccess};
if( $n != $root ) {
$prefix .= $n->{astNodeName};
print LIB "<C NAME=\"", $n->{astNodeName},
"\" REF=\"$prefix.html\">\n";
}
if( exists $n->{Ancestors} ) {
my $in;
foreach $in ( @{$n->{Ancestors}} ) {
$in =~ s/\s+//g;
print LIB "<IN NAME=\"",$in,"\">\n";
}
}
return if !exists $n->{Kids};
my $kid;
my $type;
foreach $kid ( @{$n->{Kids}} ) {
next if exists $kid->{ExtSource}
|| $kid->{Access} eq "private";
if ( exists $kid->{Compound} ) {
if( $n != $root ) {
writeNode( $kid, $prefix."::" );
}
else {
writeNode( $kid, "" );
}
next;
}
$type = $kid->{NodeType} eq "method" ?
"ME" : "M";
# mchen (1) - change so that globals are referenced via file all-globals.html
# instead of prefix.html
if ($prefix eq "") {
print LIB "<$type NAME=\"",
$kid->{astNodeName},
"\" REF=\"$all-globals.html#",
$kid->{astNodeName}, "\">\n";
} else {
print LIB "<$type NAME=\"",
$kid->{astNodeName},
"\" REF=\"$prefix.html#",
$kid->{astNodeName}, "\">\n";
}
}
if( $n != $root ) {
print LIB "</C>\n";
}
}
sub readLibrary
{
my( $rootsub, $name, $path, $relurl ) = @_;
$path = "." unless defined $path;
my $real = $path."/".$name.".kdoc";
my $url = ".";
my @stack = ();
my $version = "2.0";
my $new;
my $root = undef;
my $n = undef;
my $havecomp = -r "$real.gz";
my $haveuncomp = -r "$real";
if ( $haveuncomp ) {
open( LIB, "$real" ) || die "Can't read lib $real\n";
}
if( $havecomp ) {
if ( $haveuncomp ) {
warn "$exe: two libs exist: $real and $real.gz. "
."Using $real\n";
}
else {
open( LIB, "gunzip < \"$real.gz\"|" )
|| die "Can't read pipe gunzip < \"$real.gz\": $?\n";
}
}
while( <LIB> ) {
next if /^\s*$/;
if ( !/^\s*</ ) {
close LIB;
readOldLibrary( $root, $name, $path );
return;
}
if( /<VER\w+\s+([\d\.]+)>/ ) {
# TODO: what do we do with the version number?
$version = $1;
}
elsif ( /<BASE\s*URL\s*=\s*"(.*?)"/ ) {
$url = $1;
$url .= "/" unless $url =~ m:/$:;
my $test = kdocUtil::makeRelativePath( $relurl, $url );
print "Relative URL for '$relurl' and $url: $test\n";
$url = $test;
}
elsif( /<PLANG\s*=\s*"(.*?)">/ ) {
print "lib language: $1\n" if $main::debug;
$root = $rootsub->( $1 );
$n = $root;
}
elsif ( /<C\s*NAME="(.*?)"\s*REF="(.*?)"\s*>/ ) {
# class
$new = Ast::New( $1 );
$new->AddProp( "NodeType", "class" );
$new->AddProp( "Compound", 1 );
$new->AddProp( "ExtSource", $name );
$new->AddProp( "Ref", $url.$2 );
$root = $n = $rootsub->( "CXX" ) unless defined $root;
kdocAstUtil::attachChild( $n, $new );
push @stack, $n;
$n = $new;
}
elsif ( m#<IN\s*NAME\s*=\s*"(.*?)"\s*># ) {
# ancestor
kdocAstUtil::newInherit( $n, $1 );
}
elsif ( m#</C># ) {
# end class
$n = pop @stack;
}
elsif ( m#<(M\w*)\s+NAME="(.*?)"\s+REF="(.*?)"\s*># ) {
# member
$new = Ast::New( $2 );
$new->AddProp( "NodeType",
$1 eq "ME" ? "method" : "var" );
$new->AddProp( "ExtSource", $name );
$new->AddProp( "Flags", "" );
$new->AddProp( "Ref", $url.$3 );
kdocAstUtil::attachChild( $n, $new );
}
}
}
=head2 readLibrary
Parameters: rootnode, libname.
Read a kdoc 1.0 library into the node tree. Each external class
will have its "ExtSource" property set to the library name.
=cut
sub readOldLibrary
{
my ( $root, $libname, $libdir ) = @_;
my @nodeStack = ();
my $cnode = $root;
my $fullpath = $libdir."/".$libname.".kdoc";
my $liburl = "";
my $newNode;
my $newMem;
open( LIB, $fullpath) || die "$exe: Can't read library $fullpath\n";
$liburl = <LIB>;
carp "Empty libfile: $fullpath\n" if !defined $liburl;
$liburl =~ s/\s+//g;
while( <LIB> ) {
# class url
next if !/^([^=]+)=/;
$src = $1;
$target = $';
if ( $src =~ /::/ ) {
# member
next if !defined $newNode
|| $newNode->{astNodeName} ne $src;
$newMem = Ast::New( $' );
$newMem->AddProp( "NodeType", "Anon" );
$newMem->AddProp( "Ref", $liburl."/".$target );
kdocAstUtil::attachChild( $newNode, $newMem );
}
else {
# class
$src =~ s/^\s*(.*?)\s*$/$1/g;
$newNode = Ast::New( $src );
$newNode->AddProp( "NodeType", "class" );
$newNode->AddProp( "ExtSource", $libname );
$newNode->AddProp( "Compound", 1 );
$newNode->AddProp( "KidAccess", "public" );
$newNode->AddProp( "Ref", $liburl."/".$target );
kdocAstUtil::attachChild( $root, $newNode );
}
}
close( LIB );
}
1;
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic