Category: | GUI Programming |
Author/Contact Info | David Graff |
Description: | perldoc pod/man page viewer
Adapted (very loosely) by David Graff, from example code that came with a perl-Tk distribution. Assumes a unix or linux system running X (so we can spawn separate xterms for multiple man pages to run in the background). update: (shortly after initial post) fixed indentation and line wrapping. |
#!/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, "" ); } |
|
---|
Back to
Code Catacombs