#perl -w
#use strict;
use Pod::Html;
my %D;
my %METHOD;
my %EVENT;
my $DEBUG = 0;
Parse("../GUI.xs");
Parse("../GUI.pm");
if($ARGV[0] eq "-u") {
TbdOutput();
} elsif($ARGV[0] eq "-t") {
TxtOutput();
} elsif($ARGV[0] eq "-h") {
HtmlOutput();
} else {
HtmlOutput();
# PodOutput();
}
###############################################################################
sub Parse {
my($file) = @_;
my $package;
my $method;
my $methodname;
my $applies;
my $event;
my $thisevent;
my @packages;
my $p;
open(FILE, "<$file") or die;
while(<FILE>) {
if($method) {
if(s/^\s*#\s?//) {
$D{$package}{methods}{$method} .= $_;
} else {
$method = 0;
}
}
if($event) {
if(s/^\s*[#\*]\s?//) {
if(/\(\@\)APPLIES_TO:\s*(.*\S)\s*/) {
$applies = $1;
if($applies eq "*") {
} else {
@packages = split(/\s*,\s*/, $applies);
foreach $p (@packages) {
#$p = "Win32::GUI::".$p;
#$p =~ s/\s*$//;
$METHOD{$p} = {} unless exists($METHOD{$p});
$EVENT{$p} = {} unless exists($EVENT{$p});
$EVENT{$p}{$event} = $thisevent;
$D{$p}{events}{$event} = $thisevent;
}
}
} else {
$thisevent .= $_;
}
} else {
$event = 0;
$thisevent = "";
}
}
if(/\(\@\)PACKAGE:\s*(.*\S)\s*$/) {
$packname = $1;
($package = $packname) =~ s/Win32::GUI:://;
print "Found package: '$package'\n" if $DEBUG == 1;
$D{$package}{name} = $packname;
$D{$package}{methods} = {} unless exists $D{$package}{methods};
$D{$package}{events} = {} unless exists $D{$package}{events};
$D{$package}{attrs} = {} unless exists $D{$package}{attrs};
}
if(/\(\@\)EVENT:\s*(.*\S)\s*/) {
$event = $1;
print "Found event: '$event'\n" if $DEBUG == 1;
}
if(/\(\@\)METHOD:\s*(.*\S)\s*/) {
$methodname = $1;
($method = $methodname) =~ s/\(.*//;
print "Found method: '$method'\n" if $DEBUG == 1;
$D{$package}{methods}{$method} = "$methodname;;;";
}
}
close(FILE);
}
###############################################################################
sub newfirst {
return ($a =~ /^new/) ? -1 :
($b =~ /^new/) ? 1 : uc($a) cmp uc($b);
}
sub HtmlOutput {
my $pak;
my $page;
my $sub;
my $subname;
my $syntax;
my $content;
my $newdone;
my $nofpackages = 0;
my $nofmethods = 0;
my $nofumethods = 0;
my $nofevents = 0;
my $nofuevents = 0;
open(INDEX, ">new.html");
print INDEX "
<HTML><HEAD><TITLE>new docs</TITLE></HEAD><BODY BGCOLOR=white>
";
# objects
print INDEX qq(<B><A HREF="#objects">OBJECTS</A></B> -- );
foreach $pak (sort keys %D) {
next if $pak eq "Win32::GUI";
push(@P, qq(<A HREF="#O_$pak">$pak</A>));
}
print INDEX join(", ", @P);
# attributes
# events
@P = ();
print INDEX "<P>";
print INDEX qq(<B><A HREF="#events">EVENTS</A></B> -- );
foreach $pak (sort keys %D) {
foreach $evt (sort keys %{$D{$pak}{events}}) {
$evt =~ s/\(.*$//;
next if exists $evt{$evt};
push(@P, qq(<A HREF="#E_$evt">$evt</A>));
$evt{$evt} = 1;
}
}
print INDEX join(", ", sort @P);
# methods
@P = ();
print INDEX "<P>";
print INDEX qq(<B><A HREF="#methods">METHODS</A></B> -- );
foreach $pak (sort keys %D) {
foreach $met (sort keys %{$D{$pak}{methods}}) {
next if $met =~ /^new /;
$met =~ s/\(.*$//;
next if exists $met{$met};
push(@P, qq(<A HREF="#M_$met">$met</A>));
$met{$met} = 1;
}
}
print INDEX join(", ", sort @P);
# constructors
print INDEX qq(<H1><A NAME="objects">OBJECTS</H1>);
foreach $pak (sort keys %D) {
next if $pak eq "Win32::GUI";
print INDEX qq(<H2><A NAME="O_$pak">$pak</H2>);
%met = ();
@P = ();
foreach $met (sort keys %{$D{$pak}{methods}}) {
next unless $met =~ /^new /;
($syntax, $content) = split(/;;;/, $D{$pak}{methods}{$met});
push(@P, qq(<TT>$syntax</TT><BR>$content));
$met{$met} = 1;
}
if($#P >= 0) {
print INDEX qq(<B>CONSTRUCTOR(S)</B><P>);
print INDEX join("<P>", @P);
}
%w = ();
@P = ();
foreach $w (sort keys %{$D{$pak}{methods}}) {
next if $w =~ /^new /;
$w =~ s/\(.*$//;
next if exists $w{$w};
push(@P, qq(<A HREF="#M_$w">$w</A>));
$w{$w} = 1;
}
if($#P >= 0) {
print INDEX "<P>";
print INDEX qq(<B>METHODS</B> -- );
print INDEX join(", ", @P);
}
%w = ();
@P = ();
foreach $w (sort keys %{$D{$pak}{events}}) {
$w =~ s/\(.*$//;
next if exists $w{$w};
push(@P, qq(<A HREF="#E_$w">$w</A>));
$w{$w} = 1;
}
if($#P >= 0) {
print INDEX "<P>";
print INDEX qq(<B>EVENTS</B> -- );
print INDEX join(", ", @P);
}
print INDEX "<HR>";
}
print INDEX "</BODY></HTML>\n";
close(INDEX);
close(INDEX);
}
sub HtmlPage {
my($package) = @_;
# $package =~ s/^Win32::GUI:://;
$package =~ s/::/_/g;
return $package.".html";
}
sub HtmlStart {
my($title) = @_;
return "
<HTML>
<HEAD>
<TITLE>$title</TITLE>
</HEAD>
<BODY BGCOLOR=white>
<FONT FACE=\"Verdana, Tahoma, Arial, Helvetica\" SIZE=2>
<H3>$title</H3>
";
}
sub HtmlHeading {
my($text) = @_;
return "<B>$text</B>\n";
}
sub HtmlDefinition {
my($package, $link, $term, $definition) = @_;
#$definition =~ s/\n/<BR>\n/g;
$definition =~ s/\n(\s*)/"<BR>\n"." " x length($1)/ge;
#$definition =~ s/\s/ /g;
$definition =~ s
[see( |\s)*(also)?( |\s)*(.*\(\))]
['see'.$1.$2.' '.HtmlInternalLink($package, $4)]gie;
if($definition eq "") {
print "TBD: ${package}::${term}\n";
$definition = "<I>[TBD]</I><BR>\n";
}
if($link =~ /^e_/) {
$term = "<I>OBJECT_</I><B>$term</B>";
} else {
$term = "<B>$term</B>";
}
return "
<DT><A NAME=\"$link\">$term
<DD>$definition<BR>
";
}
sub HtmlList {
my($link, $item) = @_;
return "<LI><A HREF=\"$link\">$item</A>\n";
}
###############################################################################
sub PodOutput {
my $pak;
my $page;
my $sub;
my $subname;
my $syntax;
my $content;
my $newdone;
my $nofpackages = 0;
my $nofmethods = 0;
my $nofumethods = 0;
my $nofevents = 0;
my $nofuevents = 0;
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
open(POD, ">$page") or warn "$0: can't open $page for writing: $!";
print POD "=head2 Package $pak\n\n";
print POD "L<Back to the Packages|guipacks/>\n\n";
$newdone = 0;
print POD "=over\n\n";
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
if(!$newdone) {
if($METHOD{$pak}{$sub} =~ /^new/) {
print POD "=item *\n\nL<Constructor>\n\n=over\n\n";
} else {
print POD "=item *\n\nL<Methods>\n\n=over\n\n";
}
} elsif($newdone == 2) {
print POD "=back\n\n=item *\n\nL<Methods>\n\n=over\n\n";
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
if($METHOD{$pak}{$sub} =~ /^new/) {
$newdone = 2;
} else {
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
($subname = $syntax) =~ s/\|/|/g;
print POD "=item *\n\nL<$subname|/".htmlify(0, $syntax).">\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=back\n\n=item *\n\nL<Events>\n\n=over\n\n";
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print POD "=item *\n\nL<$sub|/".htmlify(0, $sub).">\n\n";
}
}
print POD "=back\n\n=back\n\n";
$newdone = 0;
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
if(!$newdone) {
if($METHOD{$pak}{$sub} =~ /^new/) {
print POD "=head3 Constructor\n\n=over 4\n\n";
} else {
print POD "=head3 Methods\n\n=over 4\n\n";
}
} elsif($newdone == 2) {
print POD "=back\n\n=head3 Methods\n\n=over 4\n\n";
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
$nofmethods++;
$nofumethods++ if $content eq "";
if($METHOD{$pak}{$sub} =~ /^new/) {
$newdone = 2;
} else {
$newdone = 1;
}
print "METHOD<$pak><$sub>\n" if $DEBUG == 1;
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
print POD PodDefinition($pak, $syntax, $content);
#print POD "=head4 $syntax\n\n";
#print POD "$content\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=back\n\n=head3 Events\n\n=over 4\n\n";
}
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print POD PodDefinition($pak, $sub, $EVENT{$pak}{$sub});
#print POD "=head4 $sub\n\n";
#print POD "$EVENT{$pak}{$sub}\n\n";
}
print POD "=back\n\n=cut\n";
close(POD);
$nofpackages++;
}
open(INDEX, ">pod/guipacks.pod") or warn "$0: can't open guipacks.pod for writing!";
print INDEX "=head2 Win32::GUI Packages\n\n";
print INDEX "L<Back to the index|gui/>\n\n";
print INDEX "=head3 Packages\n\n=over\n\n";
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
$page =~ s/\.pod//;
$page =~ s/^pod\///;
print INDEX "=item *\n\nL<$pak|$page/>\n\n";
}
print INDEX "=back\n\n=cut\n";
close(INDEX);
print STDERR "$nofpackages packages.\n";
print STDERR "$nofmethods methods ($nofumethods undocumented).\n";
print STDERR "$nofevents events ($nofuevents undocumented).\n";
}
sub PodPage {
my($package) = @_;
$package =~ s/^Win32::GUI:://;
$package =~ s/::/_/g;
return "pod/$package.pod";
}
sub PodDefinition {
my($package, $term, $definition) = @_;
#
# properly split literal paragraphs from plain text
#
my(@lines) = split(/\n/, $definition);
foreach my $i (0..$#lines) {
if($lines[$i] =~ /^\S/ and $lines[$i+1] =~ /^\s/) {
$lines[$i] .= "\n";
}
if($lines[$i] =~ /^\s/ and $lines[$i+1] =~ /^\S/) {
$lines[$i] .= "\n";
}
}
$definition = join("\n", @lines);
#$definition =~ s/\n(\S.*)\n/\n$1\n\n/g;
#$definition =~ s/\n(\s.*)\n(\S)/\n\n$1\n\n$2/g;
$definition =~ s
[(see\s*)(also)?(\s*)(.*\(\))]
[$1.$2.$3.' '.PodInternalLink($package, $4)]gie;
if($definition eq "") {
# print "TBD: ${package}::${term}\n";
$definition = "[TBD]\n\n";
}
return
"=for html <A NAME=\"".htmlify(0, $term)."\">\n\n"
.
"=item $term\n\n$definition\n\n"
.
"=for html <P>\n\n"
;
}
sub PodInternalLink {
my($package, $link) = @_;
my $pak;
$link =~ s/^\s*//;
$link =~ s/\s*$//;
my $name = substr($link, 0, index($link, '('));
if(defined($METHOD{$package}{$name})) {
my $section = PodLinkSyntax($package, $name);
return "L<$link|/$section>";
} elsif(defined($EVENT{$package}{$name})) {
return "L<$link|/$name>";
} else {
foreach $pak (sort keys %METHOD) {
if($METHOD{$pak}{$name}) {
my $section = PodLinkSyntax($pak, $name);
my $page = PodPage($pak);
$page =~ s/\.pod//;
$page =~ s/^pod\///;
return "L<$link|".$page."/$section>";
} elsif($EVENT{$pak}{$name}) {
my $page = PodPage($pak);
$page =~ s/\.pod//;
$page =~ s/^pod\///;
return "L<$link|".$page."/$name>";
}
}
}
warn "broken link (package: $package, link: $name)\n";
return $link;
}
sub PodLinkSyntax {
my($package, $name) = @_;
my ($syntax, $content) = split(/;;;/, $METHOD{$package}{$name});
return htmlify(0, $syntax);
}
sub PodOutput_OLD {
my $pak;
my $page;
my $sub;
my $subname;
my $syntax;
my $content;
my $newdone;
my $nofpackages = 0;
my $nofmethods = 0;
my $nofumethods = 0;
my $nofevents = 0;
my $nofuevents = 0;
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
open(POD, ">$page") or warn "$0: can't open $page for writing: $!";
print POD "=head2 Package $pak\n\n";
print POD "L<Back to the Packages|guipacks/>\n\n";
$newdone = 0;
print POD "=over\n\n";
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
if(!$newdone) {
if($METHOD{$pak}{$sub} =~ /^new/) {
print POD "=item *\n\nL<Constructor>\n\n=over\n\n";
} else {
print POD "=item *\n\nL<Methods>\n\n=over\n\n";
}
} elsif($newdone == 2) {
print POD "=back\n\n=item *\n\nL<Methods>\n\n=over\n\n";
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
if($METHOD{$pak}{$sub} =~ /^new/) {
$newdone = 2;
} else {
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
($subname = $syntax) =~ s/\|/|/g;
print POD "=item *\n\nL<$subname|/".htmlify(0, $syntax).">\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=back\n\n=item *\n\nL<Events>\n\n=over\n\n";
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print POD "=item *\n\nL<$sub|/".htmlify(0, $sub).">\n\n";
}
}
print POD "=back\n\n=back\n\n";
$newdone = 0;
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
if(!$newdone) {
if($METHOD{$pak}{$sub} =~ /^new/) {
print POD "=head3 Constructor\n\n";
} else {
print POD "=head3 Methods\n\n";
}
} elsif($newdone == 2) {
print POD "=head3 Methods\n\n";
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
$nofmethods++;
$nofumethods++ if $content eq "";
if($METHOD{$pak}{$sub} =~ /^new/) {
$newdone = 2;
} else {
$newdone = 1;
}
print "METHOD<$pak><$sub>\n" if $DEBUG == 1;
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
print POD PodDefinition($pak, $syntax, $content);
#print POD "=head4 $syntax\n\n";
#print POD "$content\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=head3 Events\n\n";
}
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print POD "=head4 $sub\n\n";
print POD "$EVENT{$pak}{$sub}\n\n";
}
print POD "=cut\n";
close(POD);
$nofpackages++;
}
open(INDEX, ">guipacks.pod") or warn "$0: can't open guipacks.pod for writing!";
print INDEX "=head2 Win32::GUI Packages\n\n";
print INDEX "L<Back to the index|gui/>\n\n";
print INDEX "=head3 Packages\n\n=over\n\n";
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
$page =~ s/\.pod//;
print INDEX "=item *\n\nL<$pak|$page/>\n\n";
}
print INDEX "=back\n\n=cut\n";
close(INDEX);
print STDERR "$nofpackages packages.\n";
print STDERR "$nofmethods methods ($nofumethods undocumented).\n";
print STDERR "$nofevents events ($nofuevents undocumented).\n";
}
sub TbdOutput {
my $pak;
my $page;
my $sub;
my $subname;
my $syntax;
my $content;
my $newdone;
my $nofpackages = 0;
my $nofmethods = 0;
my $nofumethods = 0;
my $nofevents = 0;
my $nofuevents = 0;
foreach $pak (sort keys %METHOD) {
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
$nofmethods++;
if($content eq "") {
$nofumethods++;
print "Method: ${pak}::$sub\n";
}
}
if(keys %{$EVENT{$pak}} > 0) {
foreach $sub (sort keys %{$EVENT{$pak}}) {
$nofevents++;
if($EVENT{$pak}{$sub} eq "") {
$nofuevents++;
print "Event: ${pak}::$sub\n";
}
}
}
$nofpackages++;
}
print STDERR "$nofpackages packages.\n";
print STDERR "$nofmethods methods ($nofumethods undocumented).\n";
print STDERR "$nofevents events ($nofuevents undocumented).\n";
}