\n";
}
sub writeTable
{
my ( $file, $list, $columns ) = @_;
my ( $ctr, $size ) = ( 0, int(($#$list+1)/$columns) );
$size = 1 if $size < 1;
# spread out unallocated items across columns.
# The old behaviour was to dump them in the last column.
my $s = $size * $columns;
$size++ if $s < ($#$list+1);
print $file '
';
}
=head2
Parameters: fd, 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( $file, $list, $start, $stop ) = @_;
print $file "
";
my $col = 0;
my $colour = "";
for my $ctr ( $start..$stop ) {
$col = $col ? 0 : 1;
$colour = $col ? "" : 'bgcolor="#eeeeee"';
print $file "
", refNameFull( $list->[ $ctr ] ),
"
\n";
}
print $file "
";
}
=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 ( $rootnode ) = @_;
$rootnode->{rcount} = 0 ;
return Iter::Tree ( $rootnode, 1,
sub { # common
my ( $root, $node ) = @_;
$root->{rcount}++;
$node->AddProp( 'NumRef', "#ref".$root->{rcount} );
return;
},
sub { # compound
my ( $root, $node ) = @_;
return if defined $node->{ExtSource};
if ( $node == $rootnode ) {
$node->{Ref} = "all-globals.html";
}
else {
my @heritage = kdocAstUtil::heritage( $node );
foreach my $n ( @heritage ) { $n = encodeURL( $n ); }
$node->{Ref} = join( "__", @heritage ).".html";
}
$node->{rcount} = 0 ;
return;
},
sub { # member
my ( $root, $node ) = @_;
$node->{Ref} = $root->{Ref}."#".encodeURL($node->{astNodeName})
unless defined $node->{ExtSource};
return;
}
);
}
sub makeSourceReferences
{
my( $rootnode ) = shift;
return if !exists $rootnode->{Sources};
# Set up references
foreach my $header ( @{$rootnode->{Sources}} ) {
my $htmlname = HeaderPathToHTML( $header->{astNodeName} );
$header->{Ref} = $htmlname ;
}
}
=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, $ref ) = @_;
confess "refName called with undef" unless defined $node->{astNodeName};
$ref = 'Ref' unless defined $ref;
$ref = $node->{ $ref };
my $out;
if ( !defined $ref ) {
$out = $node->{astNodeName};
} else {
$out = hyper( $ref, $node->{astNodeName} );
}
$out = "".$out."" 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 ) = @_;
my $ref = defined $refprop ? $refprop : 'Ref';
$ref = $node->{ $ref };
my $name = join( "::", kdocAstUtil::heritage( $node ) );
my $out;
if ( !defined $ref ) {
$out = $name;
} else {
$out = hyper( $ref, $name );
}
$out = "".$out."" 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 "".esc($_[1])."";
}
sub B
{
my $tag = shift;
return "<$tag>". join( "", @_). "";
}
=head2 esc
Escape special HTML characters.
=cut
sub esc
{
return $_[0] if $allowhtml;
my $str = $_[0];
return "" if !defined $str || $str eq "";
# $str =~ s/([<>&])/$escmap{$1}/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
{
my $docNode = shift;
local ( *CLASS, $rootnode ) = @_;
my ( $comp ) = @_;
my $type;
my $lasttype = "none";
$comp = defined $comp? $comp : 0;
if ( defined $docNode->{Main} ) {
print CLASS "
",
deref( $docNode->{Main}, $rootnode ), "
\n";
}
kdocDocIter::TextIter( $docNode,
sub { #start
print CLASS "
";
},
sub { #end
print CLASS "
\n";
},
sub { #text
print CLASS "",deref( $_[1], $rootnode );
},
sub { #ref
my ( $node, $name, $ref ) = @_;
print CLASS defined $ref ? refName( $ref ) : $name;
},
sub { #sect
print CLASS "\n\n
",
deref( $_[1], $rootnode),"
\n
\n";
},
sub { #pre
my ( $node, $name, $desc ) = @_;
$name = textRef( $name, $rootnode );
$desc = defined $desc ?
"
$desc
" : "";
print CLASS<
$name
$desc
EOF
},
sub { #image
print CLASS "
\n\n
\n";
},
sub { #para
print CLASS "
\n
";
},
sub { #list start
print CLASS "
\n\n
\n";
},
sub { #list end
print CLASS "
\n\n
\n";
},
sub { #item
print CLASS "
", deref( $_[1], $rootnode ), "
\n";
}
);
# Params
kdocDocIter::ParamIter( $docNode,
sub {
print CLASS "
Parameters:",
"
\n";
},
sub {
print CLASS "
\n";
},
sub {
my ( $name, $text ) = @_;
print CLASS "
",
$name, "
",
deref($text, $rootnode ), "
\n";
}
);
# Return
printTextItem( $docNode, *CLASS, "Returns" );
# Exceptions
my $text = $docNode->{Throws};
if ( defined $text ) {
my $comma = "
Throws: ";
foreach my $tosee ( @$text ) {
print CLASS $comma, esc( $tosee );
$comma = ", ";
}
print CLASS "
\n";
}
# See
my $comma = "";
kdocDocIter::SeeAlso ( $docNode, undef,
sub { # start
print CLASS "
See also: ";
},
sub { # print
my ( $label, $ref ) = @_;
$label = refName( $ref ) if defined $ref;
print CLASS $comma, $label;
$comma = ", ";
},
sub { # end
print CLASS "
\n";
}
);
return if $comp;
printTextItem( $docNode, *CLASS, "Since" );
printTextItem( $docNode, *CLASS, "Version" );
printTextItem( $docNode, *CLASS, "Id" );
printTextItem( $docNode, *CLASS, "Author" );
}
=head2 printTextItem
Parameters: node, *filehandle, prop, label
If prop is set, it prints the label and the prop value deref()ed.
=cut
sub printTextItem
{
my $node = shift;
local *CLASS = shift;
my ( $prop, $label ) = @_;
my $text = $node->{ $prop };
return unless defined $text;
$label = $prop unless defined $label;
print CLASS "
", $label, ": ",
deref( $text, $rootnode ), "
\n";
}
=head2 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 ) = @_;
my $out;
confess "rootnode is undef" if !defined $rootnode;
return "" if $str eq "";
my $ref = kdocAstSearch::findRef( $rootnode, $str );
return esc($str) if !defined $ref;
if ( defined $ref->{Ref} ) {
$out = hyper( $ref->{Ref}, $str );
}
else {
warn fullName( $ref ). " hasn't a reference.";
$out = $str;
}
return $out;
}
=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 ) = @_;
$str = esc( $str );
$str =~ s/([\w:]+)/&wordRef($1,$rootnode)/ge;
return $str;
}
=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;
# escape @x commands
foreach $text ( split (/(\@\w+(?:\s+(?:[#\w:~_]+)|\{[^}]+\}))/, $str ) ) {
# check whether $text is an @command or the text between
# @commands
if ( $text =~ /\@(\w+)(?:\s+([#\w:~_]+)|\s*\{([^}]+)\})/ ) {
my $command = $1;
my $content = $2 . $3;
# @ref -- cross reference
if ( $command eq "ref" ) {
$content =~ s/\s*#//g;
$out .= wordRef( $content, $rootnode );
}
# @p -- typewriter
elsif ( $command eq "p" ) {
$out .= "".esc($content)."";
}
# @em -- emphasized
elsif ( $command eq "em" ) {
$out .= "".esc($content)."";
}
# @sect1-4 -- section header
elsif ( $command =~ /sect([1-4])$/ ) {
$out .= "".esc($content)."";
}
# unknown command. warn and copy command
else {
warn "Unknown inline tag @", $command, "\n";
$out .= esc($text);
}
}
# no @x command, thus regular text
else {
$out .= esc($text);
}
}
return $out;
}
=head2 encodeURL
Parameters: url
Returns: encoded URL
=cut
sub encodeURL
{
my $url = shift;
my $pfx = "";
if ( $url =~ /^\s*(\w+:)/ ) {
$pfx = $1;
$url =~ s/^$pfx//;
}
$url =~ s/([:<> %])/$urlescmap{$1}/g;
return $pfx.$url;
}
=head2 tabRow
Returns a table row with each element in the arg list as
one cell.
=cut
sub tabRow
{
return "
$_[0]
$_[1]
\n";
}
=head2 makeHeader
Writes an HTML version of a file.
=cut
sub makeHeader
{
my ( $out, $filename ) = @_;
open ( SOURCE, "$filename" ) || die "Couldn't read $filename\n";
print $out "