#perl -w
use strict;
use Pod::Html;
my %METHOD;
my %EVENT;
my $DEBUG = 1;
Parse("../GUI.pm");
Parse("../Animation.xs");
Parse("../Bitmap.xs");
Parse("../Button.xs");
Parse("../Combobox.xs");
Parse("../DateTime.xs");
Parse("../DC.xs");
Parse("../Font.xs");
Parse("../GUI.xs");
Parse("../Header.xs");
Parse("../ImageList.xs");
Parse("../Label.xs");
Parse("../Listbox.xs");
Parse("../ListView.xs");
Parse("../MDI.xs");
Parse("../MonthCal.xs");
Parse("../NotifyIcon.xs");
Parse("../Rebar.xs");
Parse("../RichEdit.xs");
Parse("../Splitter.xs");
Parse("../StatusBar.xs");
Parse("../TabStrip.xs");
Parse("../Textfield.xs");
Parse("../Toolbar.xs");
Parse("../ToolTip.xs");
Parse("../Trackbar.xs");
Parse("../Treeview.xs");
Parse("../UpDown.xs");
Parse("../Window.xs");
Parse("../GUI_MessageLoops.cpp");
if($ARGV[0] eq "-u") {
TbdOutput();
} elsif($ARGV[0] eq "-t") {
TxtOutput();
} elsif($ARGV[0] eq "-h") {
HtmlOutput();
} else {
PodOutput();
}
###############################################################################
sub Parse {
my($file) = @_;
my $package;
my $method;
my $methodname;
my $applies;
my $event;
my $thisevent;
my @packages;
my $p;
print "Parse file: '$file'\n" if $DEBUG == 1;
open(FILE, "<$file") or die;
while(<FILE>) {
if($method) {
if(/\(\@\)METHOD:\s*(.*\S)\s*/) {
$methodname = $1;
($p = $methodname) =~ s/\(.*//;
$METHOD{$package}{$method} .= "See $methodname";
$method = 0;
} elsif(s/^\s*#\s?//) {
$_ = "\n" unless (length($_));
$METHOD{$package}{$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;
}
}
} else {
$thisevent .= $_;
}
} else {
$event = 0;
$thisevent = "";
}
}
if(/\(\@\)PACKAGE:\s*(.*\S)\s*$/) {
$package = $1;
print "Found package: '$package'\n" if $DEBUG == 1;
$METHOD{$package} = {} unless exists($METHOD{$package});
}
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;
$METHOD{$package}{$method} = "$methodname;;;";
}
}
close(FILE);
}
###############################################################################
sub TxtOutput {
my $pak;
my $sub;
my $syntax;
my $content;
foreach $pak (sort keys %METHOD) {
print "\n\nPACKAGE: $pak\n";
foreach $sub (sort keys %{$METHOD{$pak}}) {
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub}, 2);
$content =~ s/^/\t /;
$content =~ s/\n/\n\t /g;
print "\t* ", $syntax, "\n", $content, "\n";
}
foreach $sub (sort keys %{$EVENT{$pak}}) {
$EVENT{$pak}{$sub} =~ s/^/\t /;
$EVENT{$pak}{$sub} =~ s/\n/\n\t /g;
print "\t@ ", $sub, "\n", $EVENT{$pak}{$sub}, "\n";
}
}
}
###############################################################################
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, ">index.html");
print INDEX HtmlStart("Win32::GUI");
print INDEX HtmlHeading("Packages");
print INDEX "<UL>\n";
foreach $pak (sort keys %METHOD) {
$page = HtmlPage($pak);
print INDEX HtmlList("$page", $pak);
open(HTML, ">$page");
print HTML HtmlStart($pak);
$newdone = 0;
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
if(!$newdone) {
if($METHOD{$pak}{$sub} =~ /^new/) {
print HTML HtmlHeading("Constructor");
print HTML "<UL>\n";
} else {
print HTML HtmlHeading("Methods");
print HTML "<UL>\n";
}
} elsif($newdone == 2) {
print HTML HtmlHeading("Methods");
print HTML "<UL>\n";
$newdone = 1;
}
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
print HTML HtmlList("#m_".$sub, $syntax);
$nofmethods++;
$nofumethods++ if $content eq "";
if($METHOD{$pak}{$sub} =~ /^new/) {
print HTML "</UL>\n";
$newdone = 2;
} else {
$newdone = 1;
}
}
if(keys %{$EVENT{$pak}} > 0) {
print HTML "</UL>\n";
print HTML HtmlHeading("Events");
print HTML "<UL>\n";
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print HTML HtmlList("#e_".$subname, $sub);
$nofevents++;
$nofuevents++ if $EVENT{$pak}{$sub} eq "";
}
}
print HTML "</UL>\n<HR><DL>\n";
foreach $sub (sort newfirst keys %{$METHOD{$pak}}) {
print "METHOD<$pak><$sub>\n" if $DEBUG == 1;
($syntax, $content) = split(/;;;/, $METHOD{$pak}{$sub});
print HTML HtmlDefinition($pak, "m_".$sub, $syntax, $content);
}
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print HTML HtmlDefinition($pak, "e_".$subname, $sub, $EVENT{$pak}{$sub});
}
print HTML "</DL></BODY></HTML>\n";
close(HTML);
$nofpackages++;
}
print INDEX "</UL></BODY></HTML>\n";
close(INDEX);
print STDERR "$nofpackages packages.\n";
print STDERR "$nofmethods methods ($nofumethods undocumented).\n";
print STDERR "$nofevents events ($nofuevents undocumented).\n";
}
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;
mkdir './pod';
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
open(POD, ">$page") or warn "$0: can't open $page for writing: $!";
print POD "=head1 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 * L<Constructor|/Constructor>\n\n=over\n\n";
} else {
print POD "=item * L<Methods|/Methods>\n\n=over\n\n";
}
} elsif($newdone == 2) {
print POD "=back\n\n=item * L<Methods|/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 * L<$subname|/".htmlify($syntax).">\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=back\n\n=item * L<Events|/Events>\n\n=over\n\n";
foreach $sub (sort keys %{$EVENT{$pak}}) {
$subname = $sub;
$subname =~ s/\(.*$//;
print POD "=item * L<$sub|/".htmlify($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 "=head2 Constructor\n\n=over 4\n\n";
} else {
print POD "=head2 Methods\n\n=over 4\n\n";
}
} elsif($newdone == 2) {
print POD "=back\n\n=head2 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 "=head3 $syntax\n\n";
#print POD "$content\n\n";
}
if(keys %{$EVENT{$pak}} > 0) {
print POD "=back\n\n=head2 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 "=head3 $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 "=head1 Win32::GUI Packages\n\n";
print INDEX "L<Back to the index|GUI/>\n\n";
print INDEX "=head2 Packages\n\n=over\n\n";
foreach $pak (sort keys %METHOD) {
$page = PodPage($pak);
$page =~ s/\.pod//;
$page =~ s/^pod\///;
print INDEX "=item * L<$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";
}
my $url = htmlify($term);
$url =~ s/ /_/g;
return
"=for html <A NAME=\"".$url."\">\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($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($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($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";
}