#!/usr/bin/perl
#-------------------------------------
# perlman: perldoc pod/man page viewer
#-------------------------------------
# Adapted (very loosely) by David Graff, from example code that came
# with a perl-Tk distribution.
#
# version 1.0, 4-May-1999
# version 2.0, 20-Sep-2002: adapted to handle user-selected perl versi
+on properly
# (basically, the pod/man pages you get depend on which version of per
+l you use
# to run the app; very handy on systems where more than one version is
+ installed
use strict;
use Tk;
my ($perlbase) = grep m%lib%, @INC;
$perlbase =~ s%/lib.*%%;
my $perldoc = "$perlbase/bin/perldoc"; # /path/name of perldoc to s
+how man and pod pages
scout_man_dirs();
create_ui();
MainLoop();
#-------------------------------------------------------------------
my $showEntry; # for user to type in a doc name to "Show"
my $searchEntry; # for user to type in a string pattern to "Search
+" for
my $fullListbox; # presents complete list of perl man page names
my $srchListbox; # presents search-matched list of perl man page n
+ames
my %doclist; # hash lookup for man page file paths, keyed by m
+an page name
my $docnames; # sorted concatenation of man page names
my @docnames; # sorted array of man page names
sub show_man {
my $entry = $showEntry->get(); # get entry from $show
if ( $docnames =~ / ($entry) /i || $docnames =~ / (\w+\:+$entry) /
+i ) {
$entry = $1;
}
system( "xterm -geometry 85x45 -T '$entry' -n '$entry' -e $perldoc
+ $entry &" );
}
sub print_man {
my $entry = $showEntry->get(); # get entry from $show
if ( $docnames =~ / ($entry) /i || $docnames =~ / (\w+\:+$entry) /
+i ) {
$entry = $1;
}
system( "$perldoc $entry | enscript -2rl 2> /dev/null" );
}
sub create_ui {
my $mainWin = MainWindow->new();
$mainWin->title("Perl Documentation");
my $topFrame = $mainWin->Frame()->pack(-side => 'top', -fill => 'x
+');
my $cntlFrame = $mainWin->Frame()->pack(-side => 'top', -fill => '
+x');
my $listFrame = $mainWin->Frame()->pack(-side => 'top', -fill => '
+x');
$topFrame->Label(-text => "POD/MAN page index for Perl $]")->pack(
+-side => 'left');
$topFrame->Button(-text => 'Reload',
-command => \&scout_man_dirs )->pack(-side => 'l
+eft');
$topFrame->Button(-text => 'Exit',
-command => \&exit )->pack(-side => 'left', -pad
+x => 5);
$cntlFrame->Label(-text => 'Show:')->pack(-side => 'left', -padx =
+> 5);
$showEntry = $cntlFrame->Entry (-width => 15)->pack(-side => 'left
+');
$showEntry->bind('<KeyPress-Return>', \&show_man);
$cntlFrame->Button(-text => 'Print',
-command => \&print_man )->pack(-side => 'left'
+, -padx => 5);
$cntlFrame->Label(-text => 'Search:')->pack(-side => 'left', -padx
+ => 5);
$searchEntry = $cntlFrame->Entry (-width => 15)->pack(-side => 'le
+ft');
$searchEntry->bind('<KeyPress-Return>', \&search);
$fullListbox = $listFrame->Scrolled('Listbox',
-scrollbars => 'oe',
-width => 25,
-height => 20)->pack(-side =>
+'left');
$srchListbox = $listFrame->Scrolled('Listbox',
-scrollbars => 'oe',
-width => 25,
-height => 20)->pack(-side =>
+'left');
$fullListbox->insert( "end", @docnames );
$mainWin->bind('Tk::Listbox', '<Double-1>', \&pick_word);
}
sub pick_word {
my( $lw ) = @_;
my $mname = $lw->get( $lw->curselection );
$showEntry->delete( 0, "end" );
$showEntry->insert( 0, $mname );
show_man();
}
sub search {
my $search_pattern = $searchEntry->get();
my @search_matches = grep( /$search_pattern/i, @docnames );
$srchListbox->delete( 0, "end" );
if ( $#search_matches < 0 ) {
$srchListbox->insert( "end", "No matches for $search_pattern"
+);
} else {
$srchListbox->insert( "end", @search_matches );
}
}
use File::Basename;
sub scout_man_dirs {
my @man_files = `find $perlbase/man -name '*.[13]'`;
my @suffixes = qw/.1 .3/;
fileparse_set_fstype();
foreach my $docpath ( @man_files )
{
chomp $docpath;
my $docname = basename( $docpath, @suffixes );
$doclist{$docname} = $docpath;
}
@docnames = sort( keys( %doclist ));
$docnames = join( " ", "", @docnames, "" );
}
|