Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

#!/usr/local/bin/new/perl -w
use strict;
use blib;
my %file;
my @files;
my %cat;
my @cat;
my $podindex;
GetOptions("podindex!" => \$podindex);
sub category
{
my ($cat,$file) = @_;
unless (exists $cat{$cat})
{
$cat{$cat} = [];
push(@cat,$cat);
}
if (defined $file)
{
if (exists $file{$file})
{
if ($file{$file} ne $cat)
{
warn "$file already in $file{$file} not $cat\n";
}
}
else
{
$file{$file} = $cat;
push(@{$cat{$cat}},$file)
}
}
}
@ARGV = ("Tk.cmd") if (!@ARGV && -r "Tk.cmd");
if (@ARGV)
{
my $sec;
while (<>)
{
if (/^beginBookmark\s+'(.*)'\s*$/i)
{
$sec = $1;
category($sec);
}
elsif (/^file\s+(\S+)/)
{
my $file = $1;
if (-f $file)
{
category($sec,$file);
}
else
{
warn "Cannot find $file\n";
}
}
}
}
find(sub {
$File::Find::prune = 1 if /\b(blib|doc|pod[3n])\b/;
return if /^Tk.pod$/;
push(@files,$File::Find::name) if /\.(pod|pm)$/
},
'..');
foreach my $file (sort @files)
{
my $seen = 0;
my $pod = 0;
open(F,"$file") || die "Cannot open $file:$!";
while (<F>)
{
if (/^=for\s+category\s+(.*)$/)
{
category($1,$file);
$seen = 1;
last;
}
if (/^=head1\s*NAME/)
{
$pod = 1;
}
}
category('Other Documents',$file) if ($pod && !$seen);
if (!$pod && $file =~ /\.pm$/)
{
}
close(F);
}
if (-f "Tk.cmd")
{
copy("Tk.cmd","Tk.cmd.old");
}
system("p4",'edit',"Tk.cmd") if (-e 'Tk.cmd' && !-w 'Tk.cmd');
eval { require Tk };
if ($podindex)
{
open(POD,">../Tk.pod") || die "Cannot write to Tk.pod: $!";
print POD <<'END';
=head1 NAME
Tk - a graphical user interface toolkit for Perl
=head1 SYNOPSIS
use Tk;
$top = new MainWindow;
MainLoop;
=head1 DESCRIPTION
The Perl/Tk manual is split up into a number of sections:
END
my $no_link = 0;
foreach my $cat (@cat)
{
$no_link = ($cat =~ /C Programming/);
print POD "=head2 $cat\n\n=over 4\n\n";
foreach my $file (sort { lc($a) cmp lc($b) } @{$cat{$cat}})
{
my($base) = fileparse($file, ".(pod|pm)");
if ($no_link)
{
print POD "=item *\n\n$base\n\n";
}
else
{
my $mod = "Tk::" . $base;
print POD "=item *\n\nL<$mod|$mod>\n\n";
}
}
print POD "=back\n\n";
}
print POD <<END;
=head1 AUTHOR
Nick Ing-Simmons
=head1 SEE ALSO
L<perl(1)|perl>, L<wish(1)|wish>.
=cut
END
}
else
{
open(CMD,">Tk.cmd") || die "Cannot open Tk.cmd:$!";
print CMD <<END;
# This is a command file for pod2ps
#
cover true
booktitle 'Perl/Tk Reference'
release 'Version Tk$Tk::VERSION'
author 'Nick Ing-Simmons'
linkbox off color
pagesize a4
output tkman.ps
path .
END
foreach my $cat (@cat)
{
print CMD "beginBookmark '$cat'\n";
foreach my $file (@{$cat{$cat}})
{
print CMD "file $file '' '$cat' ''\n";
}
print CMD "endBookmark\n";
}
print CMD <<END;
ToC 1
END
}